Merge pull request #368 from lindsaycarr/master

reverse axis tests + xlim() ylim() lim() function updates

NAMESPACE

@@ -5,6 +5,7 @@ S3method(as.axis,numeric)
 S3method(as.side_name,character)
 S3method(as.side_name,numeric)
 S3method(gsplot,default)
+S3method(lim,gsplot)
 S3method(logged,gsplot)
 S3method(print,gsplot)
 S3method(summary,gsplot)

R/access-gsplot.R

@@ -97,11 +97,15 @@ ylim.gsplot <- function(object, side=NULL, set.undefined=TRUE){
 #' @export
 lim <- function(object, side, axis, set.undefined, if.null) UseMethod("lim")
 
-lim <- function(object, side=NULL, axis = NULL, set.undefined=TRUE, if.null=c(0,1)){
-  side.names <- names(sides(object))
-  if (!is.null(side))
+#' @export
+lim.gsplot <- function(object, side=NULL, axis = NULL, set.undefined=TRUE, if.null=c(0,1)){
+  all.side.names <- names(sides(object))
+  side.names <- all.side.names
+  if (!is.null(side)) {
     side.names <- as.side_name(side)
-  else {
+    side.axis <- as.axis(side)
+    if(!is.null(axis) && side.axis != axis){ warning(paste("side", side, "does not have", axis, "limits"))}
+  } else {
     if (!is.null(axis)){
       sides <- as.side(names(sides(object)))
       if (axis == 'y')
@@ -113,31 +117,56 @@ lim <- function(object, side=NULL, axis = NULL, set.undefined=TRUE, if.null=c(0,
 
   }
 
-  lims <- lapply(side.names, function(x) {
+  lims <- lapply(all.side.names, function(x) {
     lim <- object[[x]]$lim
     if (object[[x]]$reverse){
       lim <- rev(lim)
     }
     return(lim)
   })
-  names(lims) <- side.names
-  if (!is.null(side) && length(side)==1){
-    lims <- lims[[1]]
-    if (set.undefined && all(is.na(lims))){
-      lims <- lim(object, axis=as.axis(side))
-      sides <- as.side(names(lims)[sapply(lims, function(x) !any(is.na(x)))])
-      closest.side <- sides[which.min(abs(side-sides))][1]
-      if (is.null(closest.side)){
-        lims <- NULL
-      } else {
-        lims <- lims[[as.side_name(closest.side)]]  
+  names(lims) <- all.side.names
+
+  if(set.undefined){  
+    # get names of all sides on the same axis (x or y) that are not completely NA
+    which.undef <- sapply(lims, function(x) all(is.na(x)))
+    if(all(which.undef)){
+      lims <- NULL
+    } else {
+      undef.sides <- as.side(all.side.names[which.undef]) 
+      def.sides <- as.side(all.side.names[!which.undef])
+      if(is.null(side) || side %in% undef.sides){
+        for (tmp.side in undef.sides){
+          # find side closest to the undefined side (must be same axis)
+          tmp.side.name <- as.side_name(tmp.side)
+          tmp.lims <- lims[[tmp.side.name]]
+          def.sides.axis.match <- def.sides[as.axis(def.sides) == as.axis(tmp.side)]
+          closest.side <- def.sides.axis.match[which.min(abs(tmp.side-def.sides.axis.match))]
+          if (length(closest.side) == 0){
+            tmp.lims <- NULL
+          } else {
+            tmp.lims <- lims[[as.side_name(closest.side)]]  
+            match.reverse <- object[[tmp.side.name]]$reverse == object[[as.side_name(closest.side)]]$reverse
+            if(!match.reverse){
+              warning(paste("undefined limits for side", tmp.side, 
+                            ", cannot reverse; therefore, matching side", closest.side))
+            }
+          }
+          lims[[tmp.side.name]] <- tmp.lims
+        }
       }
     }
-    if (is.null(lims)){
-      lims <- if.null
-    }
   }
-
+
+  if (!is.null(lims) && !is.null(side) && length(side)==1){ ## move this to the end
+    lims <- lims[[side.names]]
+  } else {
+    lims <- lims[side.names]
+  }
+
+  if (is.null(lims)){
+    lims <- if.null
+  }
+
   return(lims)
 }
 

R/curve.R

@@ -39,7 +39,7 @@
 #'    legend()
 #' gs
 curve <- function(object, ...) {
-  override("graphics", "curve", object, ...)
+  override(package="graphics", name="curve", object=object, ...)
 }
 
 curve.gsplot <- function(object, expr, from=0, to=1, n=101, ..., legend.name=NULL, side=c(1,2)){

R/gsplot.R

@@ -16,8 +16,9 @@ pkg.env <- new.env()
       list(package='gsplot', def.funs=gsplot::callouts.default),
     'error_bar' =
       list(package='gsplot', def.funs=gsplot::error_bar.default),
+
     "par" = c(),"axis" = c(), "abline" = c(), "legend" = c(), 
-    "title" = c(), "text" = c(), "mtext" = c(), "grid" = c(), 
+    "title" = c(), "mtext" = c(), "grid" = c(), 
     "segments" = c(), "arrows" = c(), "rect" = c(), 
     "polygon" = c(), "symbols" = c(), "curve" = c()
   )

tests/testthat/tests-axis.R

@@ -23,4 +23,26 @@ test_that("axis gsplot",{
   expect_false(gs$side.1$axes)
   expect_false(gs$side.2$axes)
 
-})
+})
+
+test_that("axis reverse",{
+
+  gs <- gsplot() %>%
+    points(1:10, 1:10) %>%
+    axis(1, at = seq(0,10,by=0.1),labels=FALSE, tcl=0.15) %>%
+    axis(2, reverse=TRUE)
+
+  expect_true(gs$side.2$reverse)
+  expect_equal(ylim(gs, side=2), c(10,1))
+
+  gs2 <- gsplot() %>%
+    points(1:10, 1:10, side=c(3,2)) %>%
+    points(1:10, 1:10, side=c(1,2)) %>% 
+    axis(3, reverse=TRUE)
+
+  expect_true(gs2$side.3$reverse)
+  expect_equal(xlim(gs2, side=3), c(10,1))
+  expect_warning(ylim(gs2, side=3))
+
+})
+