Merge pull request #372 from lindsaycarr/master

more access-gsplot, plus some utils-side edits

Author: jiwalker-usgs

R/access-gsplot.R

@@ -104,7 +104,10 @@ lim.gsplot <- function(object, side=NULL, axis = NULL, set.undefined=TRUE, if.nu
   if (!is.null(side)) {
     side.names <- as.side_name(side)
     side.axis <- as.axis(side)
-    if(!is.null(axis) && side.axis != axis){ warning(paste("side", side, "does not have", axis, "limits"))}
+    side.wrong.axis <- side.names[side.axis != axis]
+    if(!is.null(axis) && length(side.wrong.axis) > 0){ 
+      warning(paste("no", axis, "axis limits for", paste(side.wrong.axis, collapse="+")))
+    }
   } else {
     if (!is.null(axis)){
       sides <- as.side(names(sides(object)))
@@ -126,14 +129,23 @@ lim.gsplot <- function(object, side=NULL, axis = NULL, set.undefined=TRUE, if.nu
   })
   names(lims) <- all.side.names
 
+  sides.notexist <- side.names[which(!side.names %in% all.side.names)]
+  for(s in sides.notexist){
+    lims[[s]] <- c(NA,NA)
+  }
+  
   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)))
+    which.undef.names <- names(lims)[which.undef]
+    # only set undefined lims for sides that exist in the object, skip if the sides do not exist
+    which.undef.names <- which.undef.names[which.undef.names %in% all.side.names]
+    which.def.names <- names(lims)[!which.undef]
     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])
+    } else if(length(which.undef.names) > 0){
+      undef.sides <- as.side(which.undef.names) 
+      def.sides <- as.side(which.def.names)
       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)

R/utils-side.R

@@ -13,7 +13,7 @@ side_names <- function(object){
 #' @return an integer vector of x sides
 #' @keywords internal
 as.x_side <- function(view.name){
-  unname(sapply(view.name, function(x) as.numeric(strsplit(x,'[.]')[[1]][2])))
+  unname(sapply(view.name, function(x) get_sides_x(as.side(x))))
 }
 
 #' take a view name and extract the named x sides
@@ -31,7 +31,7 @@ as.x_side_name <- function(view.name){
 #' @return an integer vector of y sides
 #' @keywords internal
 as.y_side <- function(view.name){
-  unname(sapply(view.name, function(x) as.numeric(strsplit(x,'[.]')[[1]][3])))
+  unname(sapply(view.name, function(x) get_sides_y(as.side(x))))
 }
 
 #' take a view name and extract the named y sides
@@ -248,3 +248,21 @@ set_sides <- function(sides){
   } 
   return(sides)
 }
+
+#' return sides that are either x (odd)
+#' 
+#' @param sides an integer vector of any length 
+#' @return the side that corresponds to x
+#' @keywords internal
+get_sides_x <- function(sides){
+    sides[sides %% 2 != 0]
+}
+
+#' return sides that are either y (even)
+#' 
+#' @param sides an integer vector of any length 
+#' @return the side that corresponds to y
+#' @keywords internal
+get_sides_y <- function(sides){
+  sides[sides %% 2 == 0]
+}