dapperstats · juniperlsimonis · Jun 3, 2022 · Sep 4, 2021 · Dec 7, 2021 · Apr 7, 2022
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -1,4 +1,6 @@
 ^ancillary$
 ^\.travis\.yml$
 ^CONTRIBUTING\.md$
-^CODE_OF_CONDUCT\.md$
+^CODE_OF_CONDUCT\.md$
+^.*\.Rproj$
+^\.Rproj\.user$
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1,42 @@
+# History files
+.Rhistory
+.Rapp.history
+
+# Session Data files
+.RData
+
+# Example code in package build process
+*-Ex.R
+
+# Output files from R CMD build
+/*.tar.gz
+
+# Output files from R CMD check
+/*.Rcheck/
+
+/reports/
+
+/
+
+# RStudio files
+.Rproj.user/
+
+# produced vignettes
+vignettes/*.html
+vignettes/*.pdf
+
+# OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
+.httr-oauth
+
+# knitr and R markdown default cache directories
+/*_cache/
+/cache/
+
+# Temporary files created by R markdown
+*.utf8.md
+*.knit.md
+
+# Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html
+rsconnect/
+
+*.Rproj
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export(axis_blank)
+export(axis_text)
 export(blank)
 export(default_nvalues)
 export(default_violin_type)
@@ -8,6 +10,7 @@ export(dist_x_values)
 export(dist_y_values)
 export(draw_probs)
 export(draw_violin)
+export(ribbon)
 export(violin)
 export(violin_length_values)
 export(violin_location)

diff --git a/R/axis_blank.R b/R/axis_blank.R
@@ -0,0 +1,89 @@
+#' @title Add an axis to a plot without labels as the default
+#'
+#' @description A wrapper function for \code{\link[base]{axis}}
+#'   with three changes.
+#'    
+#'   1. \code{labels = FALSE} is now the default.
+#'   2. \code{tck} has been added as an argument, which is used to specify the size of the tick mark.
+#'   3. \code{minor} has been added as an argument. Used to add minor (i.e., smaller) tickmarks equally between the first axis.
+
+#'
+#' @param side an integer specifying which side of the plot the axis is to be drawn on. The axis is placed as follows: 1=below, 2=left, 3=above and 4=right.
+#' 
+#' @param at The points at which tick-marks are to be drawn. Non-finite (infinite, NaN or NA) values are omitted. By default (when NULL) tickmark locations are computed using \code{\link[graphics]{axTicks}}.
+#'
+#' @param labels Set to \code{FALSE}. See \code{\link[graphics]{axis}}.
+#'
+#' @param tick See \code{\link[graphics]{axis}}.
+#'
+#' @param line See \code{\link[graphics]{axis}}.
+#'
+#' @param pos  See \code{\link[graphics]{axis}}.
+#'
+#' @param outer See \code{\link[graphics]{axis}}.
+#' 
+#' @param font See \code{\link[graphics]{axis}}.
+#' 
+#' @param lty See \code{\link[graphics]{axis}}.
+#' 
+#' @param lwd See \code{\link[graphics]{axis}}.
+#' 
+#' @param lwd.ticks See \code{\link[graphics]{axis}}.
+#' 
+#' @param col See \code{\link[graphics]{axis}}.
+#' 
+#' @param col.ticks See \code{\link[graphics]{axis}}.
+#' 
+#' @param hadj See \code{\link[graphics]{axis}}.
+#' 
+#' @param padj See \code{\link[graphics]{axis}}.
+#' 
+#' @param gap.axis See \code{\link[graphics]{axis}}.
+#' 
+#' @param tck The length of tick marks as a fraction of the smaller of the width or height of the plotting region. If tck >= 0.5 it is interpreted as a fraction of the relevant side, so if tck = 1 grid lines are drawn. The default setting is (tck = -0.025).
+#' 
+#' @param minor Whether or not to add smaller tick marks spaced equally between the larger tickmarks specified by the at argument. Tick length is set to \code{tck * 0.5}. 
+#' 
+#' @param ... Other graphical parameters that may apply to \code{\link[graphics]{axis}}.
+#' 
+#'
+#'
+#' @examples
+#' \dontrun{
+#'    blank(
+#'      xlim = c(0,50),
+#'      ylim = c(0,100),
+#'      bty ="l"
+#'    )
+#'    
+#'    axis_blank(1, at = seq(0,50,10))
+#'    axis_blank(2, at = seq(0,100,20))
+#'    
+#' }
+#'
+#' @export
+axis_blank <- function(side, at = NULL, labels = FALSE, tick = TRUE, line = NA,
+                       pos = NA, outer = FALSE, font = NA, lty = "solid",
+                       lwd = 1, lwd.ticks = lwd, col = NULL, col.ticks = NULL,
+                       hadj = NA, padj = NA, gap.axis = NA, ..., tck = -0.02, minor = TRUE){
+  if(!is.numeric(side)){
+    stop("side must be numeric. 1=below, 2=left, 3=above and 4=right.")
+  }
+  if(is.null(at)){
+    is_logged <- ifelse(side %in% c(1,3), par("xlog"), par("ylog"))
+
+    at <- axTicks(side = side, log = is_logged)
+  }
+  axis(side = side, at = at, labels = labels, tick = tick, line = line, pos = pos,
+       outer = outer, font = font, lty = lty, lwd = lwd, lwd.ticks = lwd, col = col,
+       col.ticks = col.ticks, hadj = hadj, padj = padj, gap.axis = gap.axis,
+       tck = tck, ...)
+  if(minor){
+    smaller_seq <- seq(at[1], max(at), (at[2] - at[1])/2)
+    axis(side = side, at = smaller_seq, labels = labels, tick = tick, line = line, pos = pos,
+         outer = outer, font = font, lty = lty, lwd = lwd, lwd.ticks = lwd, col = col,
+         col.ticks = col.ticks, hadj = hadj, padj = padj, gap.axis = gap.axis,
+         tck = tck/2, ...)
+
+  }
+}
diff --git a/R/axis_text.R b/R/axis_text.R
@@ -0,0 +1,72 @@
+#' @title Add labels to the axis labels
+#'
+#' @description A wrapper function for \code{\link[graphics]{mtext}}
+#'   with two changes.
+#'    
+#'   1. The default for \code{text} and \code{at} is now \code{NULL}. If both are \code{NULL}, \code{\link[graphics]{axTicks}} will be used to determine what values to include on the x (\code{side = 1}) or y (\code{side = 2})  axis. 
+#'   2. If \code{length(text) == 1} and \code{at = NULL}, then the appropriate \code{side} will find the central point of the axis to put the text (e.g., for an axis title).
+
+#' @param text a character or expression vector specifying the text to be written. See \code{\link[graphics]{mtext}}.
+#'
+#' @param side an integer specifying which side of the plot the axis is to be drawn on. The axis is placed as follows: 1=below, 2=left, 3=above and 4=right.
+#' 
+#' @param line on which MARgin line, starting at 0 counting outwards.
+#' 
+#' @param outer use outer margins if available.
+#'  
+#' @param at The location of each string in user coordinates (i.e., the text). See \code{\link[graphics]{mtext}}.
+#'
+#' @param labels Set to \code{FALSE}. See \code{\link[graphics]{axis}}.
+#' 
+#' @param adj adjustment for each string in reading direction. For strings parallel to the axes, adj = 0 means left or bottom alignment, and adj = 1 means right or top alignment. See \code{\link[graphics]{mtext}}.
+#' 
+#' @param padj adjustment for each string perpendicular to the reading direction (which is controlled by \code{adj}). See \code{\link[graphics]{mtext}}.
+#' 
+#' @param cex character expansion factor. Can be a vector.
+#' 
+#' @param col color to use. Can be a vector. \code{NA} values (the default) means use \code{par("col")}.
+#' 
+#' @param font font for text. Can be a vector. \code{NA} values (the default) means use \code{par("font")}.
+
+
+#' @param ... Other graphical parameters that may apply to \code{\link[graphics]{mtext}}.
+#' 
+#'
+#'
+#' @examples
+#' \dontrun{
+#'    blank(
+#'      xlim = c(0,50),
+#'      ylim = c(0,100),
+#'      bty ="l"
+#'    )
+#'    
+#'    axis_blank(1, at = seq(0,50,10))
+#'    axis_text(side = 1)
+#'    axis_blank(2, at = seq(0,100,20))
+#'    axis_text(side = 2)
+#'    
+#' }
+#'
+#' @export
+axis_text <- function(text = NULL, side = 3, line = 0, outer = FALSE, at = NULL,
+                      adj = NA, padj = NA, cex = NA, col = NA, font = NA, ...){
+  if(!is.numeric(side)){
+    stop("side must be numeric. 1=below, 2=left, 3=above and 4=right.")
+  }
+  if(is.null(at) & is.null(text)){
+    is_logged <- ifelse(side %in% c(1,3), par("xlog"), par("ylog"))
+
+    at <- text <- axTicks(side = side, log = is_logged)
+  }
+  if(length(text == 1) & is.null(at)){
+    if(side %% 2 == 1){
+      at <- mean(par("usr")[1:2])
+    } else {
+      at <- mean(par("usr")[3:4])
+    }
+  }
+  mtext(text = text, side = side, line = line, outer = outer,
+        at = at, adj = adj, padj = padj, cex = cex, col = col, font = font,
+        ...)
+}
diff --git a/R/ribbon.R b/R/ribbon.R
@@ -0,0 +1,137 @@
+#' @title Add a polygon to a plot
+#'
+#' @description A slight modification to \code{\link[graphics]{polygon}} 
+#'   with quality of life improvements to make it easier to add colored confidence
+#'   intervals to a plot. Default values are taken for all 
+#'   \code{\link[graphics]{polygon}} arguments, except for \code{border}, which 
+#'   is set to \code{NA}. Additionally, an \code{alpha} argument has been added to
+#'   accommodate partially transparent confidence intervals. Any of the input values
+#'   can be overwritten within this function's call.
+#'
+#' @param x vector containing the x-axis coordinates of the polygon vertices. See details for more information..
+#'
+#' @param y Either a vector containing the y-axis coordinates of the polygon vertices, or a two column data.frame / matrix with the vertices. See details for more information. 
+#'
+#' @param density Set to \code{NULL}. See \code{\link[graphics]{polygon}}.
+#'
+#' @param angle Set to \code{45}. See \code{\link[graphics]{polygon}}.
+#'
+#' @param col Set to \code{NA}. See \code{\link[graphics]{polygon}}.
+#'
+#' @param border Set to \code{NA}. See \code{\link[graphics]{polygon}}.
+#'
+#' @param lty Set to \code{par("lty")}. See \code{\link[graphics]{polygon}}.
+#' 
+#' @param ... Additional arguments such as \code{xpd}, \code{lend}, \code{ljoin}, and \code{lmitre} can be given as arugments.
+#'
+#' @param fillOddEven Set to \code{FALSE}. See \code{\link[graphics]{polygon}}.
+#' 
+#' @param alpha new alpha level in [0,1]. If \code{col} is a HEX color that already includes
+#' an alpha channel, the \code{alpha} argument will be ignored.
+#'
+#' @details 
+#' 
+#' If \code{y} is a two column data.frame or matrix, \code{ribbon} will convert \code{y} to a vector
+#' such that \code{y = c(y[,1], rev(y[,2]))} in order to create the lower and upper bounds of
+#' the polygon. Additionally, when \code{y} is a two column data.frame or matrix, \code{x} can have the same
+#' length as the number of rows in \code{y}, and \code{ribbon} will concatenate the reverse of the
+#' vector \code{x} to ensure it has equal length.
+#'
+#' @examples
+#' \dontrun{
+#'    # Load data
+#'    data(cars)
+#'    # fit model
+#'    m1 <- lm(
+#'      dist ~ speed,
+#'      data = cars
+#'    )
+#'    # make predictions
+#'    preds <- predict(
+#'      m1, 
+#'      newdata = data.frame(speed = 10:25),
+#'      interval = "confidence"
+#'    )
+#'    # base plot
+#'    blank(
+#'      xlim = c(10,25),
+#'      ylim = c(15,120),
+#'      xlab = "Speed",
+#'      ylab = "Stopping distance",
+#'      xaxt = "s",
+#'      yaxt = "s",
+#'      bty = "l",
+#'      las = 1
+#'    )
+#'    # add 95% confidence interval
+#'    ribbon(
+#'      x=10:25,
+#'      y=preds[,c("lwr","upr")],
+#'      col = "purple",
+#'      alpha = 0.5
+#'    )
+#'    # add mean prediction
+#'    lines(
+#'      x=10:25,
+#'      y = preds[,"fit"],
+#'      lwd =2,
+#'      col = "purple"
+#'    )
+#'    # add data
+#'    points(
+#'      x = cars$speed,
+#'      y = cars$dist,
+#'      pch = 16
+#'    )
+#' }
+#'
+#' @export
+ribbon <- function(x, y, density=NULL, angle=45, border=NA,
+                   col=NA, lty= par("lty"),...,fillOddEven=FALSE,
+                   alpha = NULL
+  ){
+  # error checks
+  if(!any(is.na(col)) & length(col)>1){
+    warning("Two values input to col. Only first element used.")
+    col <- col[1]
+  }
+  # check if y is a matrix
+  if(is.matrix(y)|is.data.frame(y)){
+    y <- c(y[,1], rev(y[,2]))
+    # check if x is half the length of y
+    if(length(y)/length(x) == 2){
+      x <- c(x, rev(x))
+    }
+  }
+  # evaluate color and alpha channel
+  if( is.na(col) ){
+    my_col <- NA
+  } else { # otherwise go through color process
+    # 
+    if(
+      length(grep("^#", col)) == 1 & # if start with hash
+      nchar(col)>7 # & alpha channel is present
+      ){
+        if(!is.null(alpha)){
+          warning("col already has alpha channel, ignoring alpha argument.")
+          my_col <- col
+        } else {
+          my_col <- col
+        }
+      } else {
+      # get rgb
+      my_rgbs <- col2rgb(col)
+      # set color
+      my_col <- rgb(
+        my_rgbs[1],my_rgbs[2],my_rgbs[3],max = 255,alpha = 255 * alpha
+      )
+    } 
+  }
+  polygon(
+    x = x, y = y, density = density, angle = angle,
+    border = border, col = my_col, lty = lty,
+    fillOddEven = fillOddEven, ...
+  )
+}
+
+