R/logtix.R

In mwrowe/microRutils: Mike Rowe's Miscellaneous R Utility Functions

#' Add Log-Scaled Tick Marks to an Axis
#' 
#' logtix() labels tick marks on a log-scaled axis at regular intervals with
#' untransformed (linear scale) values.
#' 
#' This function enables the user to label the axes of a plot that was generated
#' using log-transformed data (including the case where a constant was added
#' prior to log transformation), where the tick marks are labeled with "raw"
#' (untransformed) values.
#'   
#' The usr and ticfun arguments were added to permit this function to be 
#' used with plots generated by the  \code{\link{Hist}} function, by passing 
#' in the xbin or ybin function returned as an element of the list generated by
#'  \code{\link{Hist}}.  This is necessary because the values of the axis 
#' generated by  \code{\link{Hist}} are based on the number, width and spacing of 
#' bins, not the original data scale.
#'
#' @param axis
#'   Numeric vector of axes to label, accepts values in 1:4.
#' @param major
#'   Character value with regular expression indicating which ticks should
#'   should be labelled (major ticks); default will label tick marks. Default is
#'   "^(|[0\\.]+)[125]" where the (linear-scale) number starts with 1, 2 or 5.
#'   Set to "" to omit tick labels.
#' @param plus1
#'   Logical or numeric value; are values plotted as log10(x+1)?  If plus1 is
#'   a value other than 0 or 1, transform as log10(x+plus1).
#' @param base
#'   Numeric values; logarithmic base. Default is 10, use exp(1) for natural 
#'   log.
#' @param las
#'   Value specifying rientation of the tick labels-- see 
#'   help("\code{\link[graphics]{par}}").
#' @param tcl
#'   Numeric vector of major (tcl[1]) and minor (tcl[2]) tick lengths. Provide 
#'   a single number to use the same for both major and minor.
#' @param plot.tix 
#'   logical; should the ticks be added to the current plot?.
#' @param usr
#'   2-element numeric vector specifying axis limits; used in conjunction with 
#'   ticfun to apply transformations to the axis.
#' @param ticfun
#'   Function to map axis scales (see Notes).
#' @param labels
#'   Logical; should tick marks be labelled at all?
#' @param ... 
#'   Other arguments passed to the \code{\link[graphics]{axis}} function.
#'
#' @return Returns a list object which may have $x and $y elements, each
#'   with a named numeric vector of tick marks (on the plot scale) and labels 
#'   (on linear scale) for both major and minor ticks.
#' 
#' @seealso \code{\link[graphics]{par}}, \code{\link[graphics]{axis}} for more 
#'   details about plotting options.
#'   
#' @author M.W.Rowe, \email{mwr.stats@gmail.com}
#' @export
#' @importFrom graphics par
logtix <- 
function(axis=1:2, major="^(|[0\\.]+)[125]", plus1=TRUE, base=10, las=1,
   tcl=c(-0.2,-0.1), plot.tix=T, usr, ticfun=function(x) x, labels=TRUE, ...){
   plus1 <- as.numeric(plus1)
   if(length(tcl)==1) tcl <- c(tcl,tcl)
   ticks <- list()
   for(ax in axis){
      # figure out the range of ticks
      if(ax%in%c(1,3)){
         lims <- par("usr")[1:2]
         axname <- "x"
      }else{
         lims <- par("usr")[3:4]
         axname <- "y"
      }
      lims <- sort(lims)
      if(!missing(usr)) lims <- usr
      # rescale the axis limits in log base 10
      lims <- lims * log(base) / log(10)  
      near0 <- lims[1]>=log10(0.2) & lims[2]<log10(5) & plus1<1
      if(near0){
         # use a finer, symetric scale when the data range is narrow around 1
         tix <- round(c(2:10/10,10/9:2),2)
      }else{
         tix <- (1:9)*10^rep(floor(lims[1]-1):ceiling(lims[2]+1),each=9)
      }
      tix <- tix[which(log10(tix+plus1)>=lims[1] & log10(tix+plus1)<=lims[2])]
      tix <- structure(names=as.char(tix),log(tix+plus1,base))
      if(plus1==1){
         # remove tick marks below 1, except for zero
         tix <- c("0"=0,tix[which(10^tix>=2)])
      }
      ticks[[axname]] <- tix
      # plot the minor tick marks
      if(plot.tix){
         axis(ax,ticfun(tix),rep("",length(tix)),tcl=tcl[2],las=las,...)
         # plot and label major tick marks
         if(near0) these <- 1:length(tix) else these <- grep(major,names(tix))
         if(!labels){
            names(tix) <- ""
         }
         if(length(these)>0){
            axis(ax,ticfun(tix[these]),names(tix)[these],las=las,tcl=tcl[1],...)
         }else if(labels){
            warning("major argument did not identify any ticks to label")
         }
      } 
   }
   invisible(ticks)
}