Merge pull request #411 from jread-usgs/data_frame

Data frame

Author: ldecicco-USGS

NAMESPACE

@@ -73,7 +73,6 @@ 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,8 +63,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"
 
@@ -77,25 +76,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
     }
@@ -106,19 +89,9 @@ 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){
-    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)
@@ -139,7 +112,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:
 
@@ -175,4 +150,4 @@ draw_axis <- function(object, side.name){
     axis.args$tcl <- tcl
     do.call('Axis', axis.args)
   }
-}
+}

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)){
@@ -58,4 +55,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

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,41 +46,6 @@ 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,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")