Support additional type_hist() args

R/tinyplot.R

@@ -725,17 +725,19 @@ tinyplot.default = function(
       y = rep(NA, length(x))
     } else if (type == "density") {
       if (is.null(ylab)) ylab = "Density"
-    } else if (type %in% c("histogram", "function")) {
+    # } else if (type %in% c("histogram", "function")) {
+    } else if (type == "function") {
       if (is.null(ylab)) ylab = "Frequency"
-    } else {
+    } else if (type != "histogram") {
       y = x
       x = seq_along(x)
       if (is.null(xlab)) xlab = "Index"
     }
   }
 
   if (is.null(xlab)) xlab = x_dep
-  if (is.null(ylab)) ylab = y_dep
+  # if (is.null(ylab)) ylab = y_dep
+  if (is.null(ylab) && type != "histogram") ylab = y_dep
 
   # alias
   if (is.null(bg) && !is.null(fill)) bg = fill
@@ -1356,10 +1358,10 @@ tinyplot.formula = function(
   dens_type = (is.atomic(type) && identical(type, "density")) || (!is.atomic(type) && identical(type$name, "density"))
   hist_type = (is.atomic(type) && type %in% c("hist", "histogram")) || (!is.atomic(type) && identical(type$name, "histogram"))
   if (!is.null(type) && dens_type) {
-    if (is.null(ylab)) ylab = "Density"
+    # if (is.null(ylab)) ylab = "Density" ## rather assign ylab as part of internal type_density() logic
     if (is.null(xlab)) xlab = xnam
   } else if (!is.null(type) && hist_type) {
-    if (is.null(ylab)) ylab = "Frequency"
+    # if (is.null(ylab)) ylab = "Frequency" ## rather assign ylab as part of internal type_histogram() logic
     if (is.null(xlab)) xlab = xnam
   } else if (is.null(y)) {
     if (is.null(ylab)) ylab = xnam

R/type_histogram.R

@@ -24,12 +24,15 @@
 #'   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(
@@ -65,9 +68,13 @@
 #' )
 #' 
 #' @export
-type_histogram = function(breaks = "Sturges", free.breaks = FALSE, drop.zeros = TRUE) {
+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),
+        data = data_histogram(breaks = breaks,
+                              free.breaks = free.breaks, drop.zeros = drop.zeros,
+                              freq = freq, right = right),
         draw = draw_rect(),
         name = "histogram"
     )
@@ -80,46 +87,59 @@ type_histogram = function(breaks = "Sturges", free.breaks = FALSE, drop.zeros =
 type_hist = type_histogram
 
 
-data_histogram = function(breaks = "Sturges", free.breaks = FALSE, drop.zeros = TRUE) {
+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
-    fun = function(by, facet, ylab, col, bg, ribbon.alpha, datapoints, .breaks = hbreaks, .freebreaks = hfree.breaks, .drop.zeros = hdrop.zeros, ...) {
+    hfreq = freq
+    hright = right
+
+    fun = function(by, facet, ylab, col, bg, ribbon.alpha, datapoints, .breaks = hbreaks, .freebreaks = hfree.breaks, .freq = hfreq, .right = hright, .drop.zeros = hdrop.zeros, ...) {
+
         hbreaks = ifelse(!sapply(.breaks, is.null), .breaks, "Sturges")
-
-        if (is.null(ylab)) ylab = "Frequency"
+
         if (is.null(by) && is.null(palette)) {
             if (is.null(col)) col = par("fg")
             if (is.null(bg)) bg = "lightgray"
         } else {
             if (is.null(bg)) bg = ribbon.alpha
         }
 
-        if (!.freebreaks) xbreaks = hist(datapoints$x, breaks = hbreaks, plot = FALSE)$breaks
+        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, plot = FALSE)
+            h = hist(k$x, breaks = xbreaks, right = .right, plot = FALSE)
             # 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 = h$counts,
+                ymax = if (freq) h$counts else h$density,
                 xmin = h$breaks[-1],
-                xmax = h$mids + (h$mids - 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")
+        }
 
         out = list(
             x = c(datapoints$xmin, datapoints$xmax),