Themes

NAMESPACE

@@ -9,6 +9,7 @@ export(plt)
 export(plt_add)
 export(tinyplot)
 export(tinyplot_add)
+export(tinytheme)
 export(tpar)
 export(type_abline)
 export(type_area)
@@ -37,6 +38,7 @@ export(type_spline)
 export(type_vline)
 importFrom(grDevices,adjustcolor)
 importFrom(grDevices,as.raster)
+importFrom(grDevices,axisTicks)
 importFrom(grDevices,col2rgb)
 importFrom(grDevices,colorRampPalette)
 importFrom(grDevices,convertColor)

R/by_aesthetics.R

@@ -6,6 +6,15 @@ by_col = function(ngrps = 1L, col = NULL, palette = NULL, gradient = NULL, order
     ngrps = 100L
   }
 
+  if (is.null(palette)) {
+    pal_qual = get_tpar("palette.qualitative", default = NULL)
+    if (ngrps <= max(c(length(pal_qual), 8))) {
+      palette = pal_qual
+    } else {
+      palette = get_tpar("palette.sequential", default = NULL)
+    }
+  }
+
   # palette = substitute(palette, env = parent.env(environment()))
 
   # special "by" convenience keyword (will treat as NULL & handle grouping below)

R/draw_legend.R

@@ -208,7 +208,8 @@ draw_legend = function(
 
   ## restore inner margin defaults
   ## (in case the plot region/margins were affected by the preceding tinyplot call)
-  if (any(ooma != 0)) {
+  dynmar = isTRUE(.tpar[["dynmar"]])
+  if (any(ooma != 0) && !dynmar) {
     if ( ooma[1] != 0 & omar[1] == par("mgp")[1] + 1*par("cex.lab") ) omar[1] = 5.1
     if ( ooma[2] != 0 & omar[2] == par("mgp")[1] + 1*par("cex.lab") ) omar[2] = 4.1
     if ( ooma[3] == topmar_epsilon & omar[3] != 4.1 ) omar[3] = 4.1
@@ -219,7 +220,6 @@ draw_legend = function(
   par(omd = c(0,1,0,1))
   ooma = par("oma")
 
-
   ## Legend to outer side (either right or left) of plot
   if (grepl("right!$|left!$", legend_args[["x"]])) {
 
@@ -244,7 +244,22 @@ draw_legend = function(
     }
     par(mar = omar)
 
-    if (isTRUE(new_plot)) plot.new()
+    # if (isTRUE(new_plot)) plot.new()
+    if (isTRUE(new_plot)) {
+      plot.new()
+      # Experimental: For themed + dynamic plots, we need to make sure the
+      # adjusted plot margins for the legend are reinstated (after being
+      # overwritten by the before.plot.new hook.
+      if (dynmar) {
+        omar = par("mar")
+        if (outer_right) {
+          omar[4] = 0
+        } else {
+          omar[2] = par("mgp")[1] + 1*par("cex.lab")
+        }
+        par(mar = omar)
+      }
+    }
 
     legend_args[["horiz"]] = FALSE
 
@@ -290,9 +305,13 @@ draw_legend = function(
     # GM: The legend inset spacing only works _exactly_ if we refresh the plot
     # area. I'm not sure why (and it works properly if we use the same
     # parameters manually while debugging), but this hack seems to work.
-    par(new = TRUE)
+    ## v0.3.0 update: Using (temporary) hook instead of direct par(new = TRUE)
+    ## assignment to play nice with tinytheme logic.
+    oldhook = getHook("before.plot.new")
+    setHook("before.plot.new", function() par(new = TRUE), action = "append")
+    setHook("before.plot.new", function() par(mar = omar), action = "append")
     plot.new()
-    par(new = FALSE)
+    setHook("before.plot.new", oldhook, action = "replace")
     # Finally, set the inset as part of the legend args.
     legend_args[["inset"]] = c(1+inset, 0)
 
@@ -310,7 +329,7 @@ draw_legend = function(
     ## width---will be off the first time.
     if (outer_bottom) {
       omar[1] = par("mgp")[1] + 1*par("cex.lab")
-      if (isTRUE(has_sub)) omar[1] = omar[1] + 1*par("cex.sub")
+      if (isTRUE(has_sub) && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]]==1)) omar[1] = omar[1] + 1*par("cex.sub")
     } else {
       ## For "top!", the logic is slightly different: We don't expand the outer
       ## margin b/c we need the legend to come underneath the main title. So
@@ -320,7 +339,25 @@ draw_legend = function(
     }
     par(mar = omar)
 
-    if (isTRUE(new_plot)) plot.new()
+    # if (isTRUE(new_plot)) plot.new()
+    if (isTRUE(new_plot)) {
+      plot.new()
+      # Experimental: For themed + dynamic plots, we need to make sure the
+      # adjusted plot margins for the legend are reinstated (after being
+      # overwritten by the before.plot.new hook.
+      if (dynmar) {
+        omar = par("mar")
+        if (outer_bottom) {
+          # omar[1] = par("mgp")[1] + 1*par("cex.lab")
+          omar[1] = theme_clean$mgp[1] + 1*par("cex.lab") ## bit of a hack
+          if (isTRUE(has_sub) && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]]==1)) omar[1] = omar[1] + 1*par("cex.sub")
+        } else {
+          ooma[3] = ooma[3] + topmar_epsilon
+          par(oma = ooma)
+        }
+        par(mar = omar)
+      }
+    }
 
     legend_args[["horiz"]] = TRUE
 
@@ -381,9 +418,13 @@ draw_legend = function(
     # GM: The legend inset spacing only works _exactly_ if we refresh the plot
     # area. I'm not sure why (and it works properly if we use the same
     # parameters manually while debugging), but this hack seems to work.
-    par(new = TRUE)
+    ## v0.3.0 update: Using (temporary) hook instead of direct par(new = TRUE)
+    ## assignment to play nice with tinytheme logic.
+    oldhook = getHook("before.plot.new")
+    setHook("before.plot.new", function() par(new = TRUE), action = "append")
+    setHook("before.plot.new", function() par(mar = omar), action = "append") ## experimental dynmar
     plot.new()
-    par(new = FALSE)
+    setHook("before.plot.new", oldhook, action = "replace")
     # Finally, set the inset as part of the legend args.
     legend_args[["inset"]] = c(0, 1+inset)
 

R/facet.R

@@ -1,6 +1,6 @@
 # Facet layout structure
 #
-# This function is called by `tinyplot`. Given some inputs, it returns 
+# This function is called by `tinyplot`. Given some inputs, it returns
 # information about the layout of the facets.
 #
 facet_layout = function(facet, add = FALSE, facet.args = list()) {
@@ -49,7 +49,7 @@ facet_layout = function(facet, add = FALSE, facet.args = list()) {
     facets = ifacet = nfacets = oxaxis = oyaxis = 1
     cex_fct_adj = 1
   }
-  
+
   list(
     facets = facets,
     ifacet = ifacet,
@@ -119,11 +119,19 @@ get_facet_fml = function(formula, data = NULL) {
 # internal function to draw window with different facets, grids, axes, etc.
 
 draw_facet_window = function(grid, ...) {
-
   list2env(list(...), environment())
 
-  if (isFALSE(add)) {
+  # draw background color only in the grid rectangle
+  grid.bg = get_tpar("grid.bg")
+  if (!is.null(grid.bg)) {
+    corners = par("usr")
+    rect(corners[1], corners[3], corners[2], corners[4], col = grid.bg, border = NA)
+  }
 
+  ## dynamic margins flag
+  dynmar = isTRUE(.tpar[["dynmar"]])
+
+  if (isFALSE(add)) {
     ## optionally allow to modify the style of axis interval calculation
     if (!is.null(xaxs)) par(xaxs = xaxs)
     if (!is.null(yaxs)) par(yaxs = yaxs)
@@ -168,6 +176,41 @@ draw_facet_window = function(grid, ...) {
       fmar[3] = fmar[3] + facet_newlines * facet_text / cex_fct_adj
 
       omar = par("mar")
+
+      ## Dynamic plot margin adjustments
+      if (dynmar) {
+        if (par("las") %in% 1:2) {
+          # extra whitespace bump on the y axis
+          # yaxl = axTicks(2)
+          yaxl = axisTicks(usr = extendrange(ylim, f = 0.04), log = par("ylog"))
+          # whtsbp = grconvertX(max(strwidth(yaxl, "figure")), from = "nfc", to = "lines") - 1
+          whtsbp = grconvertX(max(strwidth(yaxl, "figure")), from = "nfc", to = "lines") - grconvertX(0, from = "nfc", to = "lines") - 1
+          if (whtsbp > 0) {
+            omar = omar + c(0, whtsbp, 0, 0) * cex_fct_adj
+            fmar[2] = fmar[2] + whtsbp * cex_fct_adj
+          }
+        }
+        if (par("las") %in% 2:3) {
+          # extra whitespace bump on the x axis
+          # xaxl = axTicks(1)
+          xaxl = axisTicks(usr = extendrange(xlim, f = 0.04), log = par("xlog"))
+          whtsbp = grconvertY(max(strwidth(xaxl, "figure")), from = "nfc", to = "lines") - 1
+          # whtsbp = grconvertY(max(strwidth(xaxl, "figure")), from = "nfc", to = "lines") - grconvertY(0, from = "nfc", to = "lines") - 1
+          if (whtsbp > 0) {
+            omar = omar + c(whtsbp, 0, 0, 0) * cex_fct_adj
+            fmar[1] = fmar[1] + whtsbp * cex_fct_adj
+          }
+        }
+        # FIXME: Is this causing issues for lhs legends with facet_grid?
+        # catch for missing rhs legend
+        if (isTRUE(attr(facet, "facet_grid")) && !has_legend) {
+          omar[4] = omar[4] + 1
+        }
+        # Extra reduction if no plot frame to reduce whitespace
+        if (isFALSE(frame.plot) && !isTRUE(facet.args[["free"]])) {
+          fmar[2] = fmar[2] - (whtsbp * cex_fct_adj)
+        }
+      }
 
       # Now we set the margins. The trick here is that we simultaneously adjust
       # inner (mar) and outer (oma) margins by the same amount, but in opposite
@@ -189,6 +232,31 @@ draw_facet_window = function(grid, ...) {
       # Now that the margins have been set, arrange facet rows and columns based
       # on our earlier calculations.
       par(mfrow = c(nfacet_rows, nfacet_cols))
+    } else if (dynmar) {
+      # Dynamic plot margin adjustments
+      omar = par("mar")
+      omar = omar - c(0, 0, 1, 0) # reduce top whitespace since no facet (title)
+      if (par("las") %in% 1:2) {
+        # extra whitespace bump on the y axis
+        # yaxl = axTicks(2)
+        yaxl = axisTicks(usr = extendrange(ylim, f = 0.04), log = par("ylog"))
+        # whtsbp = grconvertX(max(strwidth(yaxl, "figure")), from = "nfc", to = "lines") - 1
+        whtsbp = grconvertX(max(strwidth(yaxl, "figure")), from = "nfc", to = "lines") - grconvertX(0, from = "nfc", to = "lines") - 1
+        if (whtsbp > 0) {
+          omar[2] = omar[2] + whtsbp
+        }
+      }
+      if (par("las") %in% 2:3) {
+        # extra whitespace bump on the x axis
+        # xaxl = axTicks(1)
+        xaxl = axisTicks(usr = extendrange(ylim, f = 0.04), log = par("xlog"))
+        whtsbp = grconvertY(max(strwidth(xaxl, "figure")), from = "nfc", to = "lines") - 1
+        # whtsbp = grconvertY(max(strwidth(xaxl, "figure")), from = "nfc", to = "lines") - grconvertY(0, from = "nfc", to = "lines") - 1
+        if (whtsbp > 0) {
+          omar[1] = omar[1] + whtsbp
+        }
+      }
+       par(mar = omar)
     }
 
     ## Loop over the individual facet windows and draw the plot region
@@ -236,10 +304,32 @@ draw_facet_window = function(grid, ...) {
         yside = 2
       }
 
-      
+
       # axes, frame.plot and grid
       if (isTRUE(axes) || isTRUE(facet.args[["free"]])) {
-
+        args_x = list(x,
+          side = xside,
+          type = xaxt,
+          cex = get_tpar(c("cex.xaxs", "cex.axis"), 0.8),
+          lwd = get_tpar(c("lwd.xaxs", "lwd.axis"), 1),
+          lty = get_tpar(c("lty.xaxs", "lty.axis"), 1)
+        )
+        args_y = list(y,
+          side = yside,
+          type = yaxt,
+          cex = get_tpar(c("cex.yaxs", "cex.axis"), 0.8),
+          lwd = get_tpar(c("lwd.yaxs", "lwd.axis"), 1),
+          lty = get_tpar(c("lty.yaxs", "lty.axis"), 1)
+        )
+        type_range_x = type %in% c("pointrange", "errorbar", "ribbon", "boxplot", "p") && !is.null(xlabs)
+        type_range_y = isTRUE(flip) && type %in% c("pointrange", "errorbar", "ribbon", "boxplot", "p") && !is.null(ylabs)
+        if (type_range_x) {
+          args_x = modifyList(args_x, list(at = xlabs, labels = names(xlabs)))
+        }
+        if (type_range_y) {
+          args_y = modifyList(args_y, list(at = ylabs, labels = names(ylabs)))
+        }
+
         if (isTRUE(facet.args[["free"]]) && (par("xlog") || par("ylog"))) {
           warning(
             "\nFree scale axes for faceted plots are currently not supported if the axes are logged. Reverting back to fixed scales.",
@@ -248,20 +338,20 @@ draw_facet_window = function(grid, ...) {
           )
           facet.args[["free"]] = FALSE
         }
-        
+
         # Special logic if facets are free...
         if (isTRUE(facet.args[["free"]])) {
           # First, we need to calculate the plot extent and axes range of each
           # individual facet.
           xfree = split(c(x, xmin, xmax), facet)[[ii]]
           yfree = split(c(y, ymin, ymax), facet)[[ii]]
-          xlim = range(xfree, na.rm = TRUE) 
+          xlim = range(xfree, na.rm = TRUE)
           ylim = range(yfree, na.rm = TRUE)
           xext = extendrange(xlim, f = 0.04)
           yext = extendrange(ylim, f = 0.04)
           # We'll save this in a special .fusr env var (list) that we'll re-use
           # when it comes to plotting the actual elements later
-          if (ii==1) {
+          if (ii == 1) {
             fusr = replicate(4, vector("double", length = nfacets), simplify = FALSE)
             assign(".fusr", fusr, envir = get(".tinyplot_env", envir = parent.env(environment())))
           }
@@ -281,38 +371,16 @@ draw_facet_window = function(grid, ...) {
           } else {
             tinyAxis(yfree, side = yside, type = yaxt)
           }
-          
-        # For fixed facets we can just reuse the same plot extent and axes limits   
+
+          # For fixed facets we can just reuse the same plot extent and axes limits
         } else if (isTRUE(frame.plot)) {
           # if plot frame is true then print axes per normal...
-          if (type %in% c("pointrange", "errorbar", "ribbon", "boxplot", "p") && !is.null(xlabs)) {
-            tinyAxis(x, side = xside, at = xlabs, labels = names(xlabs), type = xaxt)
-          } else {
-            tinyAxis(x, side = xside, type = xaxt)
-          }
-          # tinyAxis(y, side = yside, type = yaxt)
-          if (isTRUE(flip) && type %in% c("pointrange", "errorbar", "ribbon", "boxplot", "p") && !is.null(ylabs)) {
-            tinyAxis(y, side = yside, at = ylabs, labels = names(ylabs), type = yaxt)
-          } else {
-            tinyAxis(y, side = yside, type = yaxt)
-          }
+          do.call(tinyAxis, args_x)
+          do.call(tinyAxis, args_y)
         } else {
           # ... else only print the "outside" axes.
-          if (ii %in% oxaxis) {
-            if (type %in% c("pointrange", "errorbar", "ribbon", "boxplot", "p") && !is.null(xlabs)) {
-              tinyAxis(x, side = xside, at = xlabs, labels = names(xlabs), type = xaxt)
-            } else {
-              tinyAxis(x, side = xside, type = xaxt)
-            }
-          }
-          if (ii %in% oyaxis) {
-            # tinyAxis(y, side = yside, type = yaxt)
-            if (isTRUE(flip) && type %in% c("pointrange", "errorbar", "ribbon", "boxplot", "p") && !is.null(ylabs)) {
-              tinyAxis(y, side = yside, at = ylabs, labels = names(ylabs), type = yaxt)
-            } else {
-              tinyAxis(y, side = yside, type = yaxt)
-            }
-          }
+          if (ii %in% oxaxis) do.call(tinyAxis, args_x)
+          if (ii %in% oyaxis) do.call(tinyAxis, args_y)
         }
       }
 
@@ -380,7 +448,6 @@ draw_facet_window = function(grid, ...) {
               if (xlog) {
                 line_height = grconvertX(line_height, from = "lines", to = "user") / grconvertX(0, from = "lines", to = "user")
                 rect_width = corners[2] * line_height
-
               } else {
                 line_height = grconvertX(line_height, from = "lines", to = "user") - grconvertX(0, from = "lines", to = "user")
                 rect_width = corners[2] + line_height
@@ -394,7 +461,6 @@ draw_facet_window = function(grid, ...) {
             if (xlog) {
               xpos = grconvertX(0.4, from = "lines", to = "user") / grconvertX(0, from = "lines", to = "user")
               xpos = corners[2] * xpos
-
             } else {
               xpos = grconvertX(0.4, from = "lines", to = "user") - grconvertX(0, from = "lines", to = "user")
               xpos = corners[2] + xpos
@@ -498,10 +564,9 @@ draw_facet_window = function(grid, ...) {
           grid
         }
       }
-      
+
       # drawn elements
       if (!is.null(draw)) eval(draw)
-
     } # end of ii facet loop
   } # end of add check
 
@@ -519,5 +584,6 @@ is_facet_position = function(position, ifacet, facet_window_args) {
     "right"  = ifacet %in% pmin(ni, seq(1L, ni, by = nc) + nc - 1L),
     "top"    = ifacet %in% head(id, nc),
     "bottom" = ifacet %in% tail(id, nc),
-    NA)
+    NA
+  )
 }