Merge pull request #415 from USGS-R/revert-411-data_frame

Revert "Data frame"

Author: ldecicco-USGS

NAMESPACE

@@ -73,6 +73,7 @@ importFrom(stats,setNames)
 importFrom(utils,find)
 importFrom(utils,getFromNamespace)
 importFrom(utils,getS3method)
+importFrom(utils,head)
 importFrom(utils,packageName)
 importFrom(utils,tail)
 importFrom(yaml,yaml.load_file)

R/axis.R

@@ -63,7 +63,8 @@ axis <- function(object, ...) {
   override("graphics", "axis", object, ...)
 }
 
-axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL) {
+#' @importFrom utils head
+axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL, append=FALSE) {
 
   fun.name <- "axis"
 
@@ -76,9 +77,25 @@ axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL) {
 
   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
     }
@@ -89,9 +106,19 @@ axis.gsplot <- function(object, ..., n.minor=0, tcl.minor=0.15, reverse=NULL) {
 }
 
 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){
+    for (axis.i in which.axis){
+      tmp <- object
+      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)
@@ -112,9 +139,7 @@ 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:
 
@@ -150,4 +175,4 @@ draw_axis <- function(object, side.name){
     axis.args$tcl <- tcl
     do.call('Axis', axis.args)
   }
-}
+}

R/function_args.R

@@ -14,15 +14,18 @@ function_args <- function(package, name, object, ..., use.default=paste0(name,'.
   params <- list(...)
 
   if (!missing(object)) {
-    params <- append_params(object, params)
+    if (!is.null(names(object)))
+      params <- append(object, params)
+    else {
+      params <- append(list(object), params)
+    }
   } else {
-    object=c()
+    object = c() # replace w/ empty
   }
 
   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)){
@@ -55,20 +58,4 @@ 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

tests/testthat/tests-axis.R

@@ -17,8 +17,8 @@ test_that("axis gsplot",{
   expect_true(all(names(gs) %in% c("side.1", "side.2", "side.3", "view.1.2", "global")))
 
   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)
@@ -46,6 +46,41 @@ test_that("axis reverse",{
 
 })
 
+context('multiple axis on the same side can be used')
+test_that("axis can append a second one",{
+  gs <- gsplot() %>% 
+    points(0:1,0:1) %>% 
+    axis(side=1, at=c(0.5,1)) %>% 
+    axis(side=1, at=c(0.25, 0.75), append=TRUE)
+  expect_equal(sum(names(gs$side.1) == 'axis'), 2)
+})
+
+test_that("axis can append a third one and the forth clears them",{
+  gs <- gsplot() %>% 
+    points(0:1,0:1) %>% 
+    axis(side=1, at=c(0.5,1)) %>% 
+    axis(side=1, at=c(0.25, 0.75), append=TRUE) %>% 
+    axis(side=1, at=c(0.45, 0.55), append=TRUE)
+  
+  expect_equal(sum(names(gs$side.1) == 'axis'), 3)
+  gs <- gsplot() %>% 
+    points(0:1,0:1) %>% 
+    axis(side=1, at=c(0.5,1)) %>% 
+    axis(side=1, at=c(0.25, 0.75), append=TRUE) %>% 
+    axis(side=1, at=c(0.45, 0.55), append=TRUE) %>% 
+    axis(side=1, at=c(0.33))
+  expect_equal(sum(names(gs$side.1) == 'axis'), 1)
+  expect_equal(gs$side.1$axis$at, 0.33)
+})
+
+test_that("axis tracks append FALSE by default",{
+  gs <- gsplot() %>% 
+    points(0:1,0:1) %>% 
+    axis(side=1, at=c(0.5,1)) %>% 
+    axis(side=1, at=c(0.25, 0.75)) %>% 
+    axis(side=1, at=c(0.45, 0.55), append=TRUE)
+  expect_equal(sum(names(gs$side.1) == 'axis'), 2)
+})
 
 context("axis user flipped on")
 

tests/testthat/tests-points.R

@@ -10,10 +10,7 @@ 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")