# Copyright (c) 2022 - 2026, Adrian Dusa
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, in whole or in part, are permitted provided that the
# following conditions are met:
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * The names of its contributors may NOT be used to endorse or promote
#       products derived from this software without specific prior written
#       permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL ADRIAN DUSA BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

#' @export
`print.declared` <- function (x, ...) {
    x <- sanitize_na_index_ (x)
    label <- label (x)
    if (!is.null (label)) {
        label <- paste ("", label)
    }

    measurement <- attr (x, "measurement")
    # type <- likely_type (x)
    cat (
        paste0 (
            "<declared<",
            # ifelse (is.null (measurement), "", paste0 (", ", measurement)),
            # ifelse (is.null (type), "", paste0 (", ", type)),
            # likely_type (x),
            ifelse (
                isTRUE (attr (x, "date")),
                "Date",
                setdiff (class (x), "declared")[1]
            ),
            ">[", length (x), "]>",
            label,
            "\n"
        )
    )

    if (length (x) > 0) {
        print (noquote (format_declared (x)), ...)

        na_values <- attr (x, "na_values")
        if (!is.null (na_values)) {
            cat (paste0 (
                "Missing values: ", paste (na_values, collapse = ", "), "\n"
            ))
        }

        na_range <- attr (x, "na_range")
        if (!is.null (na_range)) {
            cat (paste0 (
                "Missing range:  [",
                paste (na_range, collapse = ", "),
                "]\n"
            ))
        }

        labels <- attr (x, "labels", exact = TRUE)

        if (length (labels) == 0) {
            return (invisible(x))
        }

        large <- length(labels) > 7

        if (large) {
            rest <- length(labels) - 7
            labels <- labels[1:7]
        }

        cat ("\nLabels:", "\n", sep = "")

        print (
            data.frame (
                value = unname (labels),
                label = names (labels),
                row.names = NULL
            ),
            row.names = FALSE
        )

        if (large) {
            cat(paste(
                "# ... plus",
                rest,
                "more labels, use labels() to print them all.\n"
            ))
        }

        return (invisible(x))
    }
}


#' @export
`print.labels_df` <- function(x, ...) {
    class (x) <- setdiff (class (x), "labels_df")
    print_as_df <- isTRUE (attr (x, "print_as_df"))
    attr(x, "print_as_df") <- NULL
    if (print_as_df) {
        print (
            data.frame (
                value = unname (x),
                label = names (x)
            ),
            row.names = FALSE
        )
    }
    else {
        print (x)
    }
}


#' @export
`print.wtable` <- function (x, force = FALSE, startend = TRUE, ...) {
    toprint <- attr (x, "toprint")
    xlabel <- attr (toprint, "xlabel")
    ylabel <- attr (toprint, "ylabel")
    attr (toprint, "xlabel") <- NULL
    attr (toprint, "ylabel") <- NULL
    achar <- "\u00c2"
    tick <- c ("\u00b4", "\u0060", "\u2018", "\u2019") # ticks and single quotes
    tick <- c (paste0 (achar, "'"), paste0 (achar, tick), tick)

    if (!all (is.na (x)) && x[1] != as.matrix (toprint)[1]) {
        # this means the original table was altered. e.g. proportions (tbl)
        class (x) <- setdiff (class (x), c ("wtable", "array"))
        names (dimnames (x)) <- NULL
        attr (x, "toprint") <- NULL
        attr (x, "missing") <- NULL
        if (is.null (dim (x))) {
            names (x) <- gsub (paste (tick, collapse = "|"), "'", names (x))
        }
        else {
            rownames (x) <- gsub (
                paste (tick, collapse = "|"), "'", rownames (x)
            )
        }
        if (length (dimnames (x)) == 2) {
            colnames (x) <- gsub (
                paste (tick, collapse = "|"), "'", colnames (x)
            )
        }
        print (x)
    }
    else {
        x <- toprint

        if (!is.null (xlabel)) {
            cat (xlabel, "\n")
        }

        if (!is.null (ylabel)) {
            cat (ylabel, "\n")
        }

        if (is.matrix (x)) { # crosstab

            rnms <- strsplit (rownames (x), split = "_-_")

            xlabels <- sapply (rnms, tail, 1)
            # max.nchar.xlabels <- max (nchar (encodeString (xlabels)))
            # for (i in seq (length (xlabels))) {
            #     if (nchar (xlabels[i]) < max.nchar.xlabels) {
            #         xlabels[i] <- padLeft_ (
            #             xlabels[i], max.nchar.xlabels - nchar (xlabels[i])
            #         )
            #     }
            # }

            if (attr (x, "xvalues")) {
                # -length (rnms), because of "Total" which does not have a value
                xvalues <- unlist (lapply (rnms[-length (rnms)], "[[", 1))

                # suppress duplicate labels (when label equals value)
                if (length (xlabels) > 0) {
                    idx <- seq_along (xvalues)
                    xlabels[idx] <- ifelse (xlabels[idx] == xvalues, "", xlabels[idx])
                }

                max.nchar.xvalues <- max (nchar (encodeString (xvalues)))

                for (i in seq (length (xvalues) - 1)) {
                    if (nchar (xvalues[i]) < max.nchar.xvalues) {
                        xvalues[i] <- padLeft_ (
                            xvalues[i], max.nchar.xvalues - nchar (xvalues[i])
                        )
                    }
                }

                xvalues <- c (xvalues, paste(rep(" ", max.nchar.xvalues), collapse = ""))
                rnms <- paste (xvalues, xlabels)
            }
            else {
                rnms <- xlabels
            }

            rownames (x) <- rnms

            cnms <- colnames (x)
            if (attr (x, "yvalues")) {
                cnms <- vapply (
                    strsplit (cnms, split = "_-_"),
                    function(v) {
                        if ( length(v) < 2) return(v)
                        val <- v[1]
                        lab <- v[length (v)]
                        if (identical (val, lab)) {
                            val
                        } else {
                            paste (val, lab)
                        }
                    },
                    character(1L)
                )
            } else {
                cnms <- sapply (
                    strsplit (cnms, split = "_-_"),
                    tail,
                    1
                )
            }

            max.nchar.cols <- max (nchar (c (encodeString (cnms), x)))
            for (i in seq (length (cnms))) {
                if (nchar (cnms[i]) < max.nchar.cols) {
                    cnms[i] <- padBoth_ (
                        cnms[i], max.nchar.cols - nchar (cnms[i])
                    )
                }
            }
            colnames (x) <- cnms

            for (i in seq (length (x))) {
                if (nchar (x[i]) < max.nchar.cols) {
                    x[i] <- padBoth_ (x[i], max.nchar.cols - nchar (x[i]))
                }
            }

            class (x) <- setdiff (class (x), c ("w_table", "array"))
            attr (x, "xvalues") <- NULL
            attr (x, "yvalues") <- NULL
            rownames (x) <- gsub (
                paste (tick, collapse = "|"), "'", rownames (x)
            )
            colnames (x) <- gsub (
                paste (tick, collapse = "|"), "'", colnames (x)
            )
            cat (ifelse (startend, "\n", ""))
            print (noquote (x))
            cat (ifelse (startend, "\n", ""))
        }
        else {
            show_values <- attr (x, "show_values")
            valid <- attr (x, "valid")
            dots <- list (...)
            if (is.element ("show_values", names (dots))) {
                show_values <- dots$show_values
            }

            values <- gsub (
                paste (tick, collapse = "|"), "'", attr (x, "values")
            )
            labels <- gsub (
                paste (tick, collapse = "|"), "'", attr (x, "labels")
            )
            na_values <- gsub (
                paste (tick, collapse = "|"), "'", attr (x, "na_values")
            )

            first_missing <- Inf
            if (any (is.element (values, na_values))) {
                first_missing <- which (is.element (values, na_values))[1]
            }

            if (first_missing == Inf && is.na (labels[length (labels)])) {
                first_missing <- length (labels)
            }

            rnms <- labels
            max.nchar.values <- ifelse (length (values) > 0, max (nchar (values)), 0)

            if (show_values) {
                labels[!is.na (labels)][values == labels[!is.na (labels)]] <- ""
                values <- formatC (
                    as.character (values),
                    digits = max.nchar.values - 1,
                    flag = " "
                )
                rnms[!is.na (labels)] <- paste (values, labels[!is.na (labels)])
            }


            if (max.nchar.values > 1) {
                rnms[is.na (labels)] <- padLeft_ ("NA", max.nchar.values - 2)
            } else {
                if (max.nchar.values == 1) {
                    rnms[!is.na (labels)] <- sapply (
                        rnms[!is.na(labels)],
                        padLeft_,
                        max.nchar.values - 1
                    )
                }
                rnms[is.na (labels)] <- "NA"
            }

            max.nchar.cases <- max (nchar (encodeString (rnms)))
            # rnms <- sprintf (paste0 ("% ", max.nchar.cases, "s"), rnms)
            for (i in seq (length (rnms))) {
                if (nchar (rnms[i]) < max.nchar.cases) {
                    rnms[i] <- padRight_ (
                        rnms[i], max.nchar.cases - nchar (rnms[i])
                    )
                    # rnms[i] <- paste (
                    #     c (
                    #      rep (" ", max.nchar.cases - nchar (rnms[i])), rnms[i]
                    #     ),
                    #     collapse = "", sep = ""
                    # )
                }
            }

            sums <- colSums (x[, 1:3])

            fres <- formatC (as.character (c (x$fre, sums[1])), format = "s")
            fres <- paste (
                sprintf (
                    paste ("%", max (3, nchar (sums[1])), "s", sep = ""),
                    fres
                ),
                ""
            )

            x$rel <- formatC (x$rel, digits = 3, format = "f")
            rel <- sprintf ("% 5s", x$rel)
            x$per <- formatC (x$per, digits = 1, format = "f")
            if (valid & is.element ("vld", names (x))) {
                x$vld <- formatC (x$vld, digits = 1, format = "f")
                vld <- sprintf (paste ("% 5s", sep = ""), x$vld)
            }
            per <- sprintf ("% 5s", c (x$per, sums[3]))
            cpd <- formatC (x$cpd, digits = 1, format = "f")
            cpd <- sprintf (paste ("% 5s", sep = ""), cpd)

            miseparator <- paste (
                c (
                    # rep (
                    #     " ",
                    #     ifelse (max.nchar.cases > 5, max.nchar.cases - 5, 0)
                    # ),
                    rep (
                        "-",
                        min (max.nchar.cases, 5) + 1 * (sums[1] >= 1000)
                    ),
                    "\n"
                ),
                collapse = ""
            )
            separator <- paste (
                c (
                    rep (" ", max.nchar.cases + 1),
                    rep ("-", nchar (sums[1])),
                    ifelse (
                        nchar (sums[1]) < 3,
                        paste (
                            rep ("-", 3 - nchar (sums[1])),
                            collapse = ""
                        ),
                        ""
                    ),
                    sprintf (
                        "-------------------%s\n",
                        ifelse (valid, "------", "")
                    )
                ),
                collapse = ""
            )

            if (nrow (x) > 100 & !force) {
                stopError_ (paste (
                    "It looks like a lot of categories. If you really want to",
                    "print it, use:\nprint(x, force = TRUE)"
                ))
            }

            cat (ifelse (startend, "\n", ""))

            cat (
                paste (
                    rep (
                        " ",
                        max.nchar.cases + ifelse (
                            nchar (sums[1]) > 4, nchar (sums[1]) - 4, 0
                        )
                    ),
                    collapse = ""
                ),
                sprintf (ifelse (
                    sums[1] < 1000,
                    "fre    rel   per   %scpd\n",
                    " fre    rel   per   %scpd\n"
                ), ifelse (valid, "vld   ", ""))
            )

            cat (separator)

            for (i in seq (nrow (x))) {
                if (first_missing == i) {
                    cat (miseparator)
                }

                if (valid) {
                    if (i < first_missing) {
                        cat (
                            rnms[i], fres[i], rel[i], per[i], vld[i], cpd[i],
                            "\n"
                        )
                    }
                    else {
                        cat (rnms[i], fres[i], rel[i], per[i], "\n")
                    }
                }
                else {
                    cat (rnms[i], fres[i], rel[i], per[i], cpd[i], "\n")
                }
            }

            cat (separator)

            cat (
                paste (
                    rep (" ", max.nchar.cases),
                    sep = ""
                ),
                " ",
                fres[length (fres)],
                " 1.000 100.0\n",
                sep = ""
            )

            cat (ifelse (startend, "\n", ""))
        }
    }
}


#' @export
`print.fobject` <- function (x, startend = TRUE, ...) {

    class (x) <- setdiff (class (x), "fobject")

    x <- matrix(
        if (possibleNumeric_ (x)) round(asNumeric_ (x), 3) else x,
        nrow = 1,
        dimnames = list ("", names (x))
    )

    nax <- is.na (x)

    pN <- apply (x, 2, possibleNumeric_)
    nms <- colnames (x)

    cx <- x

    for (c in seq (ncol(x))) {
        xc <- x[, c]
        max.nchar.nc <- max (nchar (xc), na.rm = TRUE)
        ndec <- 0

        if (pN[c]) {
            ndec <- min (numdec_ (xc), 3)
            x[, c] <- sprintf (
                paste0 ("%", max.nchar.nc, ".", ndec, "f"),
                asNumeric_ (xc)
            )
        }

        # if (possibleNumeric_ (nms[c])) {
        #     # since this is a column name, most likely it is a whole number
        #     # e.g. the value of a declared object instead of the label
        #     nmsc <- sprintf (
        #         paste0 ("%", max.nchar.nc, ".", ndec, "f"),
        #         asNumeric_ (nms[c])
        #     )

        #     if (grepl ("[.]", nmsc)) {
        #         nmsc <- paste (
        #             unlist (strsplit (nmsc, split = "[.]"))[1],
        #             paste (rep (" ", ndec), collapse = "")
        #         )
        #     }

        #     nms[c] <- nmsc
        # }
    }

    x[nax] <- ""


    max.nchars <- max (nchar (c (encodeString (nms), x)), na.rm = TRUE)

    for (i in seq (length (nms))) {
        if (nchar (nms[i]) < max.nchars) {
            nms[i] <- padBoth_ (nms[i], max.nchars - nchar (nms[i]))
        }
    }

    for (i in seq (length (x))) {
        if (nchar (x[i]) < max.nchars) {
            x[i] <- padBoth_ (x[i], max.nchars - nchar (x[i]))
        }
    }

    colnames (x) <- nms

    cat (ifelse (startend, "\n", ""))
    print (noquote (x))
    cat (ifelse (startend, "\n", ""))

}


#' @export
`print.wmeasures` <- function (x, startend = TRUE, digits = 3, ...) {

    result <- x
    class (x) <- setdiff (class (x), "wmeasures")

    if (is.null (dim (x))) {
        x <- matrix (x, nrow = 1, dimnames = list ("", names (x)))
    }

    nms <- colnames (x)
    x <- matrix (
        apply (x, 2, format_wmeasure_column_, digits = digits),
        nrow = nrow (x),
        dimnames = dimnames (x)
    )

    widths <- pmax (
        nchar (encodeString (nms)),
        apply (x, 2, function (y) max (nchar (y)))
    )

    for (i in seq_along (nms)) {
        nms[i] <- padBoth_ (nms[i], widths[i] - nchar (nms[i]))
        x[, i] <- mapply (
            padLeft_,
            x[, i],
            widths[i] - nchar (x[, i]),
            USE.NAMES = FALSE
        )
    }

    rnms <- rownames (x)
    width_rnms <- max (nchar (rnms))
    row_prefix <- width_rnms > 0

    cat (ifelse (startend, "\n", ""))
    cat (
        paste0 (
            paste (rep (" ", width_rnms), collapse = ""),
            ifelse (row_prefix, " ", ""),
            paste (nms, collapse = "  "),
            "\n"
        )
    )

    for (i in seq (nrow (x))) {
        cat (
            ifelse (
                row_prefix,
                paste0 (padRight_ (rnms[i], width_rnms - nchar (rnms[i])), " "),
                ""
            ),
            paste (x[i, ], collapse = "  "),
            "\n",
            sep = ""
        )
    }
    cat (ifelse (startend, "\n", ""))

    return (invisible (result))
}


`format_wmeasure_column_` <- function (x, digits = 3) {

    result <- rep ("", length (x))
    ok <- !is.na (x)

    if (!any (ok)) {
        return (result)
    }

    x <- round (as.numeric (x[ok]), digits)
    ndec <- numdec_ (x, each = TRUE, maxdec = digits)
    maxdec <- max (ndec, na.rm = TRUE)

    result[ok] <- sprintf (paste0 ("%.", maxdec, "f"), x)

    return (result)
}
