Merging conflicts.

Merge branch 'master' of github.com:USGS-R/gsplot

Conflicts:
	README_files/figure-markdown_github/unnamed-chunk-2-1.png
	README_files/figure-markdown_github/unnamed-chunk-4-1.png

Author: ldecicco-USGS

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: gsplot
 Type: Package
 Title: Geological Survey Plotting
-Version: 0.4.0
+Version: 0.4.1
 Date: 2015-09-16
 Authors@R: c( person("Jordan", "Read", role = "aut",
     email = "[email protected]"),

NAMESPACE

@@ -1,7 +1,10 @@
 # Generated by roxygen2 (4.1.1): do not edit by hand
 
 S3method(gsplot,default)
+S3method(logged,gsplot)
 S3method(print,gsplot)
+S3method(xlim,gsplot)
+S3method(ylim,gsplot)
 export("%>%")
 export(abline)
 export(arrows)
@@ -19,6 +22,7 @@ export(is.gsplot)
 export(legend)
 export(lines)
 export(loadConfig)
+export(logged)
 export(mtext)
 export(par)
 export(points)
@@ -28,6 +32,8 @@ export(segments)
 export(symbols)
 export(text)
 export(title)
+export(xlim)
+export(ylim)
 exportMethods(gsplot)
 importFrom(graphics,box)
 importFrom(graphics,mtext)

R/access-gsplot.R

@@ -0,0 +1,75 @@
+
+
+#' xlim for gsplot
+#' 
+#' get the xlim for views in gsplot object
+#' 
+#' @param object a gsplot object
+#' @param side which side(s) to use
+#' 
+#' @export
+xlim <- function(object, side) UseMethod("xlim")
+
+#' @export
+xlim.gsplot <- function(object, side=NULL){
+
+  if (!is.null(side))
+    views <- object[views_with_side(views(object), side)]
+  else 
+    views <- views(object)
+  names = unname(sapply(views, function(x) paste0('side.',x$window$side[1])))
+  unique(lapply(views, function(x) x$window$xlim)) %>% 
+    setNames(unique(names))
+}
+
+#' ylim for gsplot
+#' 
+#' get the ylim for views in gsplot object
+#' 
+#' @param object a gsplot object
+#' @param side which side(s) to use
+#' 
+#' @export
+ylim <- function(object, side) UseMethod("ylim")
+
+#' @export
+ylim.gsplot <- function(object, side=NULL){
+  if (!is.null(side))
+    views <- object[views_with_side(views(object), side)]
+  else 
+    views <- views(object)
+  names = unname(sapply(views, function(x) paste0('side.',x$window$side[2])))
+  unique(lapply(views, function(x) x$window$ylim)) %>% 
+    setNames(unique(names))
+}
+
+#' log for gsplot
+#' 
+#' get the log for views in gsplot object
+#' 
+#' @name logged
+#' @param object a gsplot object
+#' @param side which side(s) to use (returns logical)
+#' @export
+logged <- function(object, side) UseMethod('logged')
+
+#' @rdname logged
+#' @export
+logged.gsplot <- function(object, side=NULL){
+  
+  is.logged <- function(window, side){
+    log = window$log
+    if (side %% 2 == 0){ # is y
+      grepl(pattern = 'y',log)
+    } else {
+      grepl(pattern = 'x',log)
+    }
+  }
+  if (!is.null(side)){
+    sapply(side, function(x) is.logged(object[[views_with_side(views(object), side=x)[1]]]$window, x))
+  } else {
+    names = unname(sapply(views(object), function(x) paste0('side.',paste(x$window$side[1:2],collapse='.'))))
+    lapply(views(object), function(x) x$window$log) %>% 
+      setNames(names)
+  }
+}

R/override.R

@@ -1,6 +1,7 @@
 #' @importFrom utils getFromNamespace
 #' @importFrom stats setNames
 #' @importFrom methods existsFunction
+
 override <- function(package, name, object, ...) {
   if(!missing(object) && class(object) == "gsplot") {
     fun <- function(object, ...) {

R/par.R

@@ -27,8 +27,12 @@ par <- function(object, ...) {
 
 
 par.gsplot <- function(object, ...){
-  current_list <- config("par")
   arguments <- list(...)
+
+   if (length(arguments)==0 && !is.null(object$par))
+     return(object$par)
+  current_list <- config("par")
+  
 
   # // only add config list items if they aren't in ..., and aren't already set in par (i.e., don't reset them)
   indicesToAdd <- !(names(current_list) %in% names(arguments)) & !(names(current_list) %in% names(object[['par']]))

man/logged.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/access-gsplot.R
+\name{logged}
+\alias{logged}
+\alias{logged.gsplot}
+\title{log for gsplot}
+\usage{
+logged(object, side)
+
+\method{logged}{gsplot}(object, side = NULL)
+}
+\arguments{
+\item{object}{a gsplot object}
+
+\item{side}{which side(s) to use (returns logical)}
+}
+\description{
+get the log for views in gsplot object
+}
+

man/xlim.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/access-gsplot.R
+\name{xlim}
+\alias{xlim}
+\title{xlim for gsplot}
+\usage{
+xlim(object, side)
+}
+\arguments{
+\item{object}{a gsplot object}
+
+\item{side}{which side(s) to use}
+}
+\description{
+get the xlim for views in gsplot object
+}
+

man/ylim.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/access-gsplot.R
+\name{ylim}
+\alias{ylim}
+\title{ylim for gsplot}
+\usage{
+ylim(object, side)
+}
+\arguments{
+\item{object}{a gsplot object}
+
+\item{side}{which side(s) to use}
+}
+\description{
+get the ylim for views in gsplot object
+}
+

tests/testthat/test-access_gsplot.R

@@ -0,0 +1,70 @@
+context("test get xlim for gsplot object")
+test_that("xlim for single axis", {
+  
+  usrDef <- gsplot(mar=c(4,4,4,4), xaxs='r', yaxs='r') %>% 
+    points(x=1, y=2, side=c(3,2), legend.name="Points 1", cex=3, xlab='cat')
+  
+  expect_equal(xlim(usrDef)[[1]], c(1,1))
+  
+  usrDef <- points(usrDef,x=3:10,y=4:11, side=c(3,2))
+  
+  expect_equal(xlim(usrDef)[[1]], c(1,10))
+  
+})
+
+test_that("xlim for dual axis", {
+  
+  usrDef <- gsplot(mar=c(4,4,4,4), xaxs='r', yaxs='r') %>% 
+    points(x=1, y=2, side=c(3,2), legend.name="Points 1", cex=3, xlab='cat') %>% 
+    points(x=3:10,y=4:11, side=c(1,2))
+  
+  expect_equal(xlim(usrDef)[[1]], c(1,1))
+  expect_equal(xlim(usrDef)[[2]], c(3,10))
+  
+})
+
+test_that("xlim for string input", {
+  
+  usrDef <- gsplot(mar=c(4,4,4,4), xaxs='r', yaxs='r') %>% 
+    points(x=1, y=2, side=c(3,2), legend.name="Points 1", cex=3, xlab='cat') %>% 
+    points(x=3:10,y=4:11, side=c(1,2))
+  
+  expect_equal(xlim(usrDef)[['side.3']], c(1,1))
+  expect_equal(xlim(usrDef, side = 3)[[1]], c(1,1))
+  expect_equal(xlim(usrDef, side = 1)[[1]], c(3,10))
+  
+})
+
+context("test get par for gsplot object")
+
+test_that("par for simple object",{
+  expect_equal(par(gsplot(mar=c(4,4,4,4), xaxs='r', yaxs='r'))$xaxs,'r')
+  expect_is(par(gsplot(mar=c(4,4,4,4), xaxs='r', yaxs='r')), 'list')
+})
+
+context("test get logged for gsplot object")
+
+test_that("logged for simple object",{
+  usrDef <- gsplot(mar=c(4,4,4,4), xaxs='r', yaxs='r') %>% 
+    points(x=1, y=2, side=c(3,2), legend.name="Points 1", cex=3, xlab='cat') %>% 
+    points(x=3:10,y=4:11, side=c(1,2))
+  expect_equal(logged(usrDef)[[1]],"")
+  expect_equal(logged(usrDef)[[2]],"")
+  
+  usrDef <- lines(usrDef,1:2,4:5, log='xy')
+  expect_equal(logged(usrDef)[[1]],"")
+  expect_equal(logged(usrDef)[[2]],"xy")
+  
+})
+
+test_that("logged side extractor ",{
+  usrDef <- gsplot(mar=c(4,4,4,4), xaxs='r', yaxs='r') %>% 
+    points(x=1, y=2, side=c(3,2), legend.name="Points 1", cex=3, xlab='cat',log='y') %>% 
+    points(x=3:10,y=4:11, side=c(1,2), log='xy')
+  expect_true(logged(usrDef, side=1))
+  expect_false(logged(usrDef, side=3))
+  
+  dual = logged(usrDef, side=c(1,2))
+  expect_equal(length(dual), 2)
+  expect_true(all(dual))
+})