#' Histogram plot type
#'
#' @md
#' @description Type function for histogram plots. `type_hist` is an alias for
#'   `type_histogram`.
#' @param breaks Passed to \code{\link[graphics]{hist}}. One of:
#' - a vector giving the breakpoints between histogram cells,
#' - a function to compute the vector of breakpoints,
#' - a single number giving the number of cells for the histogram,
#' - a character string naming an algorithm to compute the number of cells (see ‘Details’ of \code{\link[graphics]{hist}}),
#' - a function to compute the number of cells.
#' In the last three cases the number is a suggestion only; as the breakpoints
#' will be set to pretty values, the number is limited to 1e6 (with a warning if
#' it was larger). If breaks is a function, the x vector is supplied to it as
#' the only argument (and the number of breaks is only limited by the amount of
#' available memory).
#' @param free.breaks Logical indicating whether the breakpoints should be
#'   computed separately for each group or facet? Default is `FALSE`, meaning
#'   that the breakpoints are computed from the full dataset; thus ensuring
#'   common bin widths across each group/facet. Can also use `free` as an
#'   acceptable argument alias. Ignored if there are no groups and/or facets.
#' @param drop.zeros Logical indicating whether bins with zero counts should be
#'   dropped before plotting. Default is `TRUE`. Note that switching to `FALSE`
#'   may interfere with faceted plot behaviour if `facet.args = list(free)`,
#'   since the `x` variable is effectively recorded over the full range of the
#'   x-axis (even if it does not extend over this range for every group).
#' @inheritParams graphics::hist
#' @examples
#' # "histogram"/"hist" type convenience string(s)
#' tinyplot(Nile, type = "histogram")
#'
#' # Use `type_histogram()` to pass extra arguments for customization
#' tinyplot(Nile, type = type_histogram(breaks = 30))
#' tinyplot(Nile, type = type_histogram(breaks = 30, freq = FALSE))
#' # etc.
#'
#' # Grouped histogram example
#' tinyplot(
#'     ~ Petal.Width | Species,
#'     type = "histogram",
#'     data = iris
#' )
#'
#' # Faceted version
#' tinyplot(
#'     ~Petal.Width,
#'     facet = ~Species,
#'     type = "histogram",
#'     data = iris
#' )
#'
#' # For visualizing faceted histograms across varying scales, you may also wish
#' # to impose free histogram breaks too (i.e., calculate breaks separately for
#' # each group). Compare:
#'
#' # free facet scales + shared histogram breaks, versus...
#' tinyplot(
#'     ~Petal.Width,
#'     facet = ~Species,
#'     facet.args = list(free = TRUE),
#'     type = type_histogram(),
#'     data = iris
#' )
#' # ... free facet scales + free histogram breaks
#' tinyplot(
#'     ~Petal.Width,
#'     facet = ~Species,
#'     facet.args = list(free = TRUE),
#'     type = type_histogram(free = TRUE),
#'     data = iris
#' )
#'
#' @export
type_histogram = function(breaks = "Sturges",
                          freq = NULL, right = TRUE,
                          free.breaks = FALSE, drop.zeros = TRUE) {
    out = list(
        data = data_histogram(
            breaks = breaks,
            free.breaks = free.breaks, drop.zeros = drop.zeros,
            freq = freq, right = right),
        draw = draw_rect(),
        name = "histogram"
    )
    class(out) = "tinyplot_type"
    return(out)
}
#' @export
#' @name type_hist
#' @rdname type_histogram
type_hist = type_histogram


data_histogram = function(breaks = "Sturges",
                          free.breaks = FALSE, drop.zeros = TRUE,
                          freq = NULL, right = TRUE) {
    hbreaks = breaks
    hfree.breaks = free.breaks
    hdrop.zeros = drop.zeros
    hfreq = freq
    hright = right

    fun = function(settings, .breaks = hbreaks, .freebreaks = hfree.breaks, .freq = hfreq, .right = hright, .drop.zeros = hdrop.zeros, ...) {
        env2env(settings, environment(), c("palette", "bg", "col", "plot", "datapoints", "ymin", "ymax", "xmin", "xmax", "freq", "ylab", "xlab", "facet", "ribbon.alpha", "by", "null_by", "null_palette"))

        has_weights = !is.null(datapoints[["weights"]])
        if (has_weights) settings$weights_used = TRUE

        hbreaks = ifelse(!sapply(.breaks, is.null), .breaks, "Sturges")

        # Multi-group displays fill from the palette at `ribbon.alpha`
        # transparency via the `ribbon.alpha` keyword. For single-group displays
        # with a theme palette active we leave `bg = NULL` so the fill tracks the
        # resolved border colour (see by_bg), which honours `col.default`. With
        # no theme palette, single-group uses the neutral "lightgray" shared by
        # all single-group area fills (matches base R hist()).
        if (is.null(bg) && !null_by) {
          bg = ribbon.alpha
        } else if (is.null(bg) && null_by && null_palette && is.null(get_tpar("palette.qualitative", default = NULL))) {
          bg = "lightgray"
        }

        if (!.freebreaks) xbreaks = hist(datapoints$x, breaks = hbreaks, right = .right, plot = FALSE)$breaks
        datapoints = split(datapoints, list(datapoints$by, datapoints$facet))
        datapoints = Filter(function(k) nrow(k) > 0, datapoints)

        datapoints = lapply(datapoints, function(k) {
            if (.freebreaks) xbreaks = breaks
            h = hist(k$x, breaks = xbreaks, right = .right, plot = FALSE)
            # weighted histogram: hist() has no weights arg, so recompute the bin
            # counts as weighted sums and rescale densities to integrate to 1.
            if (has_weights) {
                bin = findInterval(k$x, h$breaks, rightmost.closed = TRUE, left.open = .right)
                bin[bin < 1L] = 1L
                wsum = vapply(seq_along(h$mids), function(b) sum(k$weights[bin == b]), numeric(1))
                bw = diff(h$breaks)
                h$counts = wsum
                h$density = wsum / sum(k$weights) / bw
            }
            # zero count cases
            if (.drop.zeros) {
                nzidx = which(h$counts > 0)
                h$density = h$density[nzidx]
                h$counts = h$counts[nzidx]
                h$breaks = h$breaks[c(1, nzidx + 1)]
                h$mids = h$mids[nzidx]
            }
            freq = if (!is.null(.freq)) .freq else is.null(.freq) && h$equidist
            out = data.frame(
                by = k$by[1], # already split
                facet = k$facet[1], # already split
                ymin = 0,
                ymax = if (freq) h$counts else h$density,
                xmin = h$breaks[-1],
                xmax = h$mids + (h$mids - h$breaks[-1]),
                freq = freq
            )
            return(out)
        })
        datapoints = do.call(rbind, datapoints)

        if (is.null(ylab)) {
            ylab = ifelse(datapoints$freq[1], "Frequency", "Density")
        }

        x = c(datapoints$xmin, datapoints$xmax)
        y = c(datapoints$ymin, datapoints$ymax)
        ymin = datapoints$ymin
        ymax = datapoints$ymax
        xmin = datapoints$xmin
        xmax = datapoints$xmax
        by = if (length(unique(datapoints$by)) == 1) by else datapoints$by
        facet = if (length(unique(datapoints$facet)) == 1) facet else datapoints$facet
        
        # legend customizations
        settings$legend_args[["pch"]] = settings$legend_args[["pch"]] %||% 22
        settings$legend_args[["pt.cex"]] = settings$legend_args[["pt.cex"]] %||% 3.5
        settings$legend_args[["pt.lwd"]] = settings$legend_args[["pt.lwd"]] %||% par("lwd")
        settings$legend_args[["lty"]] = settings$legend_args[["lty"]] %||% 0
        settings$legend_args[["y.intersp"]] = settings$legend_args[["y.intersp"]] %||% 1.25
        settings$legend_args[["seg.len"]] = settings$legend_args[["seg.len"]] %||% 1.25
        
        env2env(environment(), settings, c(
            "x",
            "y",
            "ymin",
            "ymax",
            "xmin",
            "xmax",
            "ylab",
            "col",
            "bg",
            "datapoints",
            "by",
            "facet"
        ))
    }
    return(fun)
}
