Points.formula

.gitignore

@@ -1,6 +1,8 @@
 # History files
 .Rhistory
 .Rapp.history
+*.Rproj
+**.DS_Store
 
 # Example code in package build process
 *-Ex.R
@@ -11,4 +13,5 @@
 # produced vignettes
 vignettes/*.html
 vignettes/*.pdf
+tests/testthat/*.pdf
 .Rproj.user

NAMESPACE

@@ -18,6 +18,7 @@ export(legend)
 export(lines)
 export(loadConfig)
 export(mtext)
+export(par)
 export(points)
 export(segments)
 export(text)

R/calc_views.R

@@ -122,6 +122,10 @@ set_view_lim <- function(views){
 c_unname <- function(list){
   unname(do.call(c, list))
 }
+
+unname_c <- function(list){
+  do.call(c, unname(list))
+}
 views_with_side <- function(views, side){
   with.side = lapply(views, function(x) any(x[['window']][['side']] %in% side))
   unname(which(unlist(with.side[names(with.side) == 'view'])))
@@ -167,8 +171,13 @@ strip_pts <- function(list, var){
   for (v in var){
     if (v %in% names(list))
       out <- append(out, list[[v]])
-    else
-      out <- append(out, NA)
+    else {
+      u.list <- unname_c(list)
+      if(v %in% names(u.list))
+        out <- append(out, u.list[[v]])
+      else
+        out <- append(out, NA)
+    }
   }
   return(out)
 }

R/gsplot-class.R

@@ -14,7 +14,7 @@ gsplot <- function(x = NULL, ...) UseMethod("gsplot")
 #' @rdname gsplot
 #' @export
 gsplot.default <- function(...) {
-  gsplot.list(list(par=list(...)))
+  par.gsplot(gsplot.list(list()), ...)
 }
 
 #' @rdname gsplot

R/override.R

@@ -25,17 +25,31 @@ graphics_params <- function(package, name, object, ...){
   if (!missing(object)) {
     if (!is.null(names(object)))
       params <- append(object, params)
-    else 
+    else {
       params <- append(list(object), params)
+    }
+  } else {
+    object = c() # replace w/ empty
   }
 
-  defFun <- getFromNamespace(ifelse(existsFunction(paste0(name,".default")), paste0(name,".default"), name), package)
+  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)){
+    defFun <- getFromNamespace(ifelse(existsFunction(paste0(name,".default")), paste0(name,".default"), name), package)
+  }
 
   arg.names = names(formals(defFun))[which(!names(formals(defFun)) %in% names(params))]
 
   if (is.null(names(params))){
     # // all are unnamed
-    names(params) <- arg.names[1:length(params)]
+    if (arg.names[seq_len(length(params))][1] == "..."){
+      # // special case where unnamed args go to ..., and should remain as characters (such as par("usr"))
+      return(params)
+    } 
+    names(params) <- arg.names[seq_len(length(params))]
   } else {
     names(params)[which(names(params) == "")] <- arg.names[seq_len(sum(names(params) == ""))]
   }

R/par.R

@@ -0,0 +1,46 @@
+#' Set or Query Graphical Parameters
+#'
+#' par can be used to set or query graphical parameters. 
+#' Parameters can be set by specifying them as arguments 
+#' to par in tag = value form, or by passing them as a list 
+#' of tagged values.
+#' 
+#' @param object gsplot object
+#' @param \dots Further graphical parameters may also be supplied as arguments. See \code{\link[graphics]{par}}
+#' 
+#' 
+#' @export
+#' @examples
+#' gs2 <- gsplot(new=TRUE,mar=c(5,4,1,2)) %>%
+#'   points(1, 2) %>%
+#'   bgCol(col="white") 
+#' gs2
+#' 
+#' gs2 <- gsplot(new=TRUE, cex=1.2) %>%
+#'   points(1, 2) %>%
+#'   bgCol(col="white") %>%
+#'   par(new=FALSE, mar=c(5,4,3,3), cex=2.1) 
+#' gs2
+par <- function(object, ...) {
+  override("graphics", "par", object, ...)
+}
+
+
+par.gsplot <- function(object, ...){
+  current_list <- config("par")
+  arguments <- list(...)
+
+  # // 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']]))
+  arguments <- append(arguments, current_list[indicesToAdd])
+
+  if ("par" %in% names(object)){
+    # // keep any par that shouldn't be overwritten. The rest are dropped/replaced
+    cur.par <- names(object[['par']])
+    keep.par <- cur.par[!cur.par %in% names(arguments)]
+    arguments <- append(arguments, object[['par']][keep.par])
+    object[['par']] <- NULL
+  } 
+  object <- append(object, list(par = arguments))
+  return(gsplot(object))
+}

R/points.R

@@ -26,9 +26,9 @@ points <- function(object, ...) {
 }
 
 
-points.gsplot <- function(object, x, y=NULL, ..., legend.name=NULL, side=c(1,2)){
+points.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
   current_list <- config("points")
-  arguments <- list(x=x, y=y, ...)
+  arguments <- list(...)
 
   indicesToAdd <- !(names(current_list) %in% names(arguments))
   arguments <- append(arguments, current_list[indicesToAdd])

R/print.R

@@ -29,21 +29,19 @@ print.gsplot <- function(x, ...){
   # -- set plot -- 
   views = calc_views(x)
 
-  if(!par()$new & !isTRUE(config("par", views$par)$new)){
+  if(!isTRUE(x[['par']][['new']])){
     dev.hold()
     on.exit(dev.flush())
     plot.new()
   }
-
-
-  defaultPar <- par(no.readonly = TRUE)#, mar=legend_adjusted_margins(x))
+
 
   for (i in which(names(views) %in% 'view')){
     plots = views[[i]]
     plots[['window']] <- NULL
     window = views[[i]][['window']]
 
-    par(config("par", views$par))
+    par(views[['par']])
 
     plot.window(xlim = window$xlim, ylim = window$ylim, log = window$log)
 

man/par.Rd

@@ -0,0 +1,32 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/par.R
+\name{par}
+\alias{par}
+\title{Set or Query Graphical Parameters}
+\usage{
+par(object, ...)
+}
+\arguments{
+\item{object}{gsplot object}
+
+\item{\dots}{Further graphical parameters may also be supplied as arguments. See \code{\link[graphics]{par}}}
+}
+\description{
+par can be used to set or query graphical parameters.
+Parameters can be set by specifying them as arguments
+to par in tag = value form, or by passing them as a list
+of tagged values.
+}
+\examples{
+gs2 <- gsplot(new=TRUE,mar=c(5,4,1,2)) \%>\%
+  points(1, 2) \%>\%
+  bgCol(col="white")
+gs2
+
+gs2 <- gsplot(new=TRUE, cex=1.2) \%>\%
+  points(1, 2) \%>\%
+  bgCol(col="white") \%>\%
+  par(new=FALSE, mar=c(5,4,3,3), cex=2.1)
+gs2
+}
+

tests/testthat/tests-par.R

@@ -0,0 +1,30 @@
+context("par")
+
+test_that("lists and named args are identical", {
+  gs <- gsplot(cex=1.2) %>% 
+    par(cex=3.2)
+  expect_equal(gs[['par']][['cex']],3.2)
+  gs <- gsplot(cex=1.2)
+  expect_equal(gs[['par']][['cex']],1.2)
+
+})
+
+test_that("a more complicated par set", {
+  gs <- gsplot(cex=1.2) %>% 
+    par(cex=3.2) %>%
+    par(cex=3.8,mar=c(4,4,4,4)) %>% 
+    points(3,2,cex=2)
+  expect_equal(gs[['par']][['cex']],3.8)
+})
+
+test_that("par is a list",{
+  gs <- gsplot(cex=1.2)
+  expect_is(gs[['par']], 'list')
+  expect_is(par(), 'list')
+})
+
+test_that("graphics par behaves as expected",{
+  expect_is(par("usr")[c(1,2)], 'numeric')
+  expect_equal(par("usr")[c(1,2)],par()$usr[c(1,2)])
+  expect_equal(gsplot::par("usr","mar"), graphics::par("usr","mar"))
+})

tests/testthat/tests-points.R

@@ -41,3 +41,20 @@ test_that("testing content of gsplot list", {
 
 })
 
+test_that("override works w/ formulas",{
+  dev.off()
+  plot(-4:4, -4:4, type = "n") 
+  points(y~x, data=list(x=-3:3,y=-3:3))  # // no errors
+})
+
+test_that("points.gsplot accepts formulas",{
+  gs <- gsplot() %>%
+       points(y~x, data=list(x=-3:3,y=-3:3))
+  views <- gsplot:::group_views(gs) %>% 
+    gsplot:::set_view_lim()
+  expect_equal(views$view$window$xlim, c(-3,3))
+  expect_equal(views$view$window$ylim, c(-3,3))
+  gs
+
+})
+