Merge branch 'master' of github.com:USGS-R/gsplot

Author: Jordan S Read

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: gsplot
 Type: Package
 Title: Geological Survey Plotting
-Version: 0.7.0
-Date: 2016-07-13
+Version: 0.7.3
+Date: 2017-02-16
 Authors@R: c( person("Jordan", "Read", role = "aut",
     email = "[email protected]"),
     person("Laura", "DeCicco", role = c("aut","cre"),
@@ -26,7 +26,7 @@ Copyright: This software is in the public domain because it contains materials
     that originally came from the United States Geological Survey, an agency of
     the United States Department of Interior. For more information, see the
     official USGS copyright policy at
-    http://www.usgs.gov/visual-id/credit_usgs.html#copyright
+    https://www.usgs.gov/visual-id/credit_usgs.html#copyright
 Imports:
     magrittr,
     stats,
@@ -43,4 +43,4 @@ VignetteBuilder: knitr
 BuildVignettes: true
 LazyLoad: yes
 LazyData: yes
-RoxygenNote: 5.0.1
+RoxygenNote: 6.0.1

NAMESPACE

@@ -19,12 +19,16 @@ export(abline)
 export(arrows)
 export(as.side_name)
 export(axis)
-export(bgCol)
-export(bgCol.default)
+export(background_color)
+export(background_color.default)
 export(callouts)
 export(callouts.default)
+export(clear_par)
 export(config)
 export(curve)
+export(date_axis)
+export(date_axis.default)
+export(date_axis.gsplot)
 export(error_bar)
 export(error_bar.default)
 export(grid)
@@ -43,9 +47,13 @@ export(rect)
 export(segments)
 export(symbols)
 export(text)
+export(theme.hadley)
+export(theme.packers)
 export(title)
 export(view)
 export(view_info)
+export(whatDate)
+export(whatVersion)
 export(xlab)
 export(xlim)
 export(ylab)
@@ -67,13 +75,14 @@ importFrom(lazyeval,lazy_dots)
 importFrom(lazyeval,lazy_eval)
 importFrom(magrittr,"%>%")
 importFrom(methods,existsFunction)
+importFrom(methods,getPackageName)
 importFrom(stats,median)
 importFrom(stats,na.omit)
 importFrom(stats,setNames)
 importFrom(utils,find)
 importFrom(utils,getFromNamespace)
 importFrom(utils,getS3method)
-importFrom(utils,head)
+importFrom(utils,packageDescription)
 importFrom(utils,packageName)
 importFrom(utils,tail)
 importFrom(yaml,yaml.load_file)

R/abline.R

@@ -32,5 +32,8 @@ abline <- function(object, ...) {
 abline.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
   fun.name <- 'abline'
   object <- gather_function_info(object, fun.name, ..., legend.name=legend.name, side=side)
+
+  object <- modify_side(object, args = list(...), side=side)
+  
   return(object)
 }

R/access-gsplot.R

@@ -258,4 +258,28 @@ view_info <- function(object){
   viewInfo$y.side.defined.by.user <- viewInfo$y %in% defined.sides
 
   return(viewInfo)
-}
+}
+
+#' Get gsplot object creation date.
+#' 
+#' Get the date that this gsplot object was originally created.
+#' 
+#' @param object a gsplot object
+#' @return The date the gsplot object was created.
+#' @export
+whatDate <- function(object){
+  date_created <- object$metadata$created
+  return(date_created)
+}
+
+#' Get gsplot version used.
+#' 
+#' Get the version number that was used to create this gsplot object.
+#' 
+#' @param object a gsplot object
+#' @return The gsplot version number.
+#' @export
+whatVersion <- function(object){
+  version_created <- object$metadata$gsplot.version
+  return(version_created)
+}

R/add_to_view.R

@@ -64,7 +64,7 @@ add_to_view <- function(object, call.args, side, where){
 #' gs <- gsplot() %>% 
 #'          points(x=1:5, y=1:5, xlim=c(0,10), ylim=c(0,10), 
 #'                callouts(labels=c(rep(NA, 4), "oh")), 
-#'                error_bar(y.high=1))
+#'                error_bar(offset.up=1))
 #' gs
 #' 
 #' gsplot:::filter_arguments('points', x=2:6, y=2:6, ylim=c(-1, 11))$call.args

R/arrows.R

@@ -23,8 +23,8 @@
 #'    abline(b=1, a=0, legend.name="1:1") %>%
 #'    legend(location="topleft",title="Awesome!") %>%
 #'    grid() %>%
-#'    error_bar(x=1:3, y=c(3,1,2), y.high=c(0.5,0.25,1), y.low=0.1) %>%
-#'    error_bar(x=1:3, y=c(3,1,2), x.low=.2, x.high=.2, col="red",lwd=3) %>%
+#'    error_bar(x=1:3, y=c(3,1,2), offset.up=c(0.5,0.25,1), offset.down=0.1) %>%
+#'    error_bar(x=1:3, y=c(3,1,2), offset.left=.2, offset.right=.2, col="red",lwd=3) %>%
 #'    arrows(x0=0.75, y0=2, x1=1, y1=2.8, lwd=2) %>%
 #'    title("Graphing Fun") %>%
 #'    text(.75,1.75,labels="Weird data")

R/axis.R

@@ -18,7 +18,7 @@
 #' gs <- gsplot() %>%
 #'    points(x=1:5, y=1:5, legend.name="Stuff") %>%
 #'    lines(2:6, y=2:6, ylim=c(0,10)) %>%
-#'    bgCol(col="lightgoldenrod") %>%
+#'    background_color(col="lightgoldenrod") %>%
 #'    axis(side=c(3,4),labels=FALSE) %>%
 #'    legend("topright")
 #' gs
@@ -64,7 +64,6 @@ axis <- function(object, ...) {
   override("graphics", "axis", object, ...)
 }
 
-#' @importFrom utils head
 axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL, append=FALSE) {
 
   fun.name <- "axis"
@@ -79,25 +78,14 @@ axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL, ap
 
   for(side in sides){
     # append the side and give it defaults if it doesn't exist
-    
-    object <- modify_side(object, args = list(), side=side) 
-    which.axis <- which(names(object[[as.side_name(side)]])== 'axis')
-    if (append){
-      last.axis <- tail(which.axis, 1) # get the last one
-      object[[as.side_name(side)]] <- append(object[[as.side_name(side)]], 
-                                             list('axis' = set_args('axis', side=side, package='graphics')), 
-                                             after = last.axis)
-      object[[as.side_name(side)]][[last.axis+1]] <- append_replace(object[[as.side_name(side)]][[last.axis+1]], user_args[[fun.name]])
+    if(append){
+      
     } else {
-      # remove
-      if (length(which.axis) > 1){
-        # remove all axis functions other than the first one
-        object[[as.side_name(side)]] <- object[[as.side_name(side)]][-which.axis[!which.axis %in% head(which.axis, 1)]]  
-      }
-      object[[as.side_name(side)]][['axis']] <- append_replace(object[[as.side_name(side)]][['axis']], user_args[[fun.name]])
+      object <- modify_side(object, args = list(), side=side) 
     }
-    object[[as.side_name(side)]][['usr.axes']] <- TRUE
 
+    object[[as.side_name(side)]][['usr.axes']] <- TRUE
+    object[[as.side_name(side)]][['axis']] <- append_replace(object[[as.side_name(side)]][['axis']], user_args[[fun.name]])
     if (!is.null(reverse)){
       object[[as.side_name(side)]][['reverse']] <- reverse
     }
@@ -108,6 +96,8 @@ axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL, ap
 }
 
 draw_axis <- function(object, side.name){
+
+
   # method isn't made for multiple axis calls
   which.axis <- which(names(object[[side.name]]) == 'axis')
   if (length(which.axis) > 1){
@@ -116,11 +106,11 @@ draw_axis <- function(object, side.name){
       tmp[[side.name]] <- tmp[[side.name]][-which.axis[which.axis %in% axis.i]]
       draw_axis(tmp, side.name)
     }
-    
   }
+
   axis.args <- object[[side.name]][['axis']]
   side.lim <- object[[side.name]][['lim']]
-
+  
   axis.args$at <- get_axTicks(object, as.side(side.name))
 
   # need a cleaner way to extract the non-axis args (such as n.minor and tcl.minor)
@@ -141,7 +131,9 @@ draw_axis <- function(object, side.name){
     axis.args$n.minor <- NULL
     axis.args$tcl.minor <- NULL
 
-    do.call('Axis', axis.args)    
+    do.call('Axis', axis.args)
+    
+    
 
     # Minor axis:
 

R/bgCol.R

@@ -1,4 +1,4 @@
-#' gsplot bgCol
+#' gsplot background_color
 #'
 #' Adds color to the plot background. 
 #' 
@@ -10,35 +10,37 @@
 #' @examples
 #' gs <- gsplot() %>%
 #'    points(y=c(3,1,2), x=4:6, xlim=c(0,NA),legend.name="Points") %>%
-#'    bgCol(col="lightgrey") %>%
+#'    background_color(col="lightgrey") %>%
 #'    lines( c(3,4,3), c(2,4,6), legend.name="Lines", side=c(3,4)) %>%
 #'    legend(location="topleft")      
 #' gs
 #' 
 #' gs <- gsplot() %>%
 #'    points(1:100, rnorm(100,mean=10000, sd=1000), log="y") %>%
-#'    bgCol(col="lightgrey")
+#'    background_color(col="lightgrey")
 #' gs
 #' 
 #' gs <- gsplot() %>%
 #'    points(1:100, rnorm(100,mean=10000, sd=1000), log="y") %>%
-#'    bgCol() #yaml specifies lightgrey
+#'    background_color() #yaml specifies lightgrey
 #' gs
 #' 
 #' gs <- gsplot() %>%
 #'    points(1:100, rnorm(100,mean=10000, sd=1000), log="y") %>%
-#'    bgCol("lightgoldenrod") 
+#'    background_color("lightgoldenrod") 
 #' gs
-bgCol <- function(object, ...) {
-  override("gsplot", "bgCol", object, ...)
+background_color <- function(object, ...) {
+  override("gsplot", "background_color", object, ...)
 }
 
 
-bgCol.gsplot <- function(object, ...){
+background_color.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
 
-  to.gsplot <- filter_arguments(fun.name = "bgCol", ...,
-                                custom.config = object[["global"]][["config"]][["config.file"]])$call.args
-  object$global$bgCol <- append_replace(object$global$bgCol, to.gsplot[[1]])
+  fun.name='background_color'
+
+  arguments <- filter_arguments(fun.name, ..., custom.config = object[["global"]][["config"]][["config.file"]], side=side)
+  object[["global"]] <- append_replace(object[["global"]], arguments$call.args)
+  
   return(object)
 
 }
@@ -50,7 +52,7 @@ bgCol.gsplot <- function(object, ...){
 #' Here NULL means color 0.
 #' @export
 #' @keywords internal
-bgCol.default <- function(col=NULL){
+background_color.default <- function(col=NULL){
 
   if(par()$xlog){
     x1 <- 10^(par("usr")[1])

R/config.R

@@ -1,6 +1,15 @@
 gsconfig <- new.env(parent = emptyenv())
 gsconfig$original.par <- par(no.readonly = TRUE)
 
+#' Clear par
+#' 
+#' Resets par to what it was when gsplot was loaded.
+#' 
+#' @export
+clear_par <- function(){
+  par(gsconfig$original.par)
+}
+
 #Question...how can I update the user's par?
 
 #' @title Load gsplot config
@@ -38,20 +47,18 @@ loadConfig = function(filename) {
 #'used elsewhere in the application. This will only change the config paremeters while
 #'building up the gsplot object, not on print.
 #'
-#' @param filename string to custom file 
+#' @param object gsplot object
 #'
 #' @importFrom graphics plot.xy
 #' @importFrom graphics par
 #' @importFrom yaml yaml.load_file
 #' @importFrom grDevices dev.off
-load_temp_config = function(filename) {
-  
-  graphTemplate <- yaml.load_file(filename)
+load_temp_config = function(object){
 
   if(length(all.equal(gsconfig$original.par, par(no.readonly = TRUE))) > 1){
     par(gsconfig$original.par)
   }
-  gsconfig$temp.config <- graphTemplate
+  gsconfig$temp.config <- object[["config"]]
 }