Merge pull request #422 from lindsaycarr/brokenFormulas

be able to use formulas and data lists

Author: ldecicco-USGS

R/axis.R

@@ -64,8 +64,7 @@ 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) {
+axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL) {
 
   fun.name <- "axis"
 
@@ -79,25 +78,9 @@ 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]])
-    } 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[[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 +91,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){
@@ -117,9 +102,10 @@ draw_axis <- function(object, side.name){
       draw_axis(tmp, side.name)
     }
   }
-  axis.args <- object[[side.name]][['axis']]
-  side.lim <- object[[side.name]][['lim']]
 
+  master  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)
@@ -140,7 +126,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/function_args.R

@@ -14,18 +14,15 @@ function_args <- function(package, name, object, ..., use.default=paste0(name,'.
   params <- list(...)
 
   if (!missing(object)) {
-    if (!is.null(names(object)))
-      params <- append(object, params)
-    else {
-      params <- append(list(object), params)
-    }
+    params <- append_params(object, params)
   } else {
-    object = c() # replace w/ empty
+    object=c()
   }
 
   if (length(params) == 0)
     return(list())
 
+  
   # // is there a method for this class?
   defFun <- getS3method(name,class(object),optional=TRUE) # will be NULL when object is missing
   if (is.null(defFun)){
@@ -65,4 +62,20 @@ function_args <- function(package, name, object, ..., use.default=paste0(name,'.
   return(params)
 }
 
+append_params <- function(object, params){
+  UseMethod('append_params')
+}
+
+append_params.NULL <- function(object, params){
+  params
+}
+
+append_params.list <- function(object, params){
+  append(object, params)
+}
+
+append_params.default <- function(object, params){
+  append(list(object), params)
+}
+
 user_function_args <- function_args

R/utils-list.R

@@ -34,6 +34,9 @@ strip_pts <- function(list, param){
   for (v in param){
     if (v %in% names(list) && !inherits(list[[v]], c('function','formula'))) {
       v.vals <- list[[v]]
+      if(is.list(v.vals)){
+        v.vals <- strip_pts(v.vals, param)
+      }
       out <- append_keepTZ(out, v.vals, tz=attr(v.vals, 'tzone'))
       all.na <- all(is.na(v.vals))
       out.class <- ifelse(!all.na, class(v.vals), out.class)
@@ -43,7 +46,7 @@ strip_pts <- function(list, param){
     } else {
       if (any(sapply(list, is.list))){
         u.list <- unname_c(list[sapply(list, is.list)])
-        if(v %in% names(u.list)) {
+        if(v %in% names(u.list) && !inherits(u.list[[v]], c('function','formula'))) {
           v.vals <- u.list[[v]]
           out <- append_keepTZ(out, v.vals, tz=attr(v.vals, 'tzone'))
           all.na <- all(is.na(v.vals))

tests/testthat/tests-axis.R

@@ -18,8 +18,8 @@ test_that("axis gsplot",{
                                    "view.1.2", "global", "metadata")))
 
   gs <- gsplot() %>%
-     lines(1:5, c(1,10,100,1000,10000), log="y", axes=FALSE) %>%
-     axis(side=c(2,4), labels=FALSE, n.minor=4)
+    lines(1:5, c(1,10,100,1000,10000), log="y", axes=FALSE) %>%
+    axis(side=c(2,4), labels=FALSE, n.minor=4)
 
   expect_false(gs$side.1$axes)
   expect_false(gs$side.2$axes)

tests/testthat/tests-points.R

@@ -10,7 +10,10 @@ test_that("graphics examples work", {
   lx <- seq(1, 5, length = 41)
   xy = xy.coords(x=10^lx,y=exp(-.5*lx^2))
   plot.xy(xy, type='p')
-
+  
+  plot(1,3)
+  points(data.frame(1,2), col='red')
+  
 })
 
 context("points arguments")