Merge pull request #271 from ldecicco-USGS/master

grid, bgCol, title

DESCRIPTION

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

NAMESPACE

@@ -3,6 +3,7 @@
 S3method(gsplot,default)
 S3method(logged,gsplot)
 S3method(print,gsplot)
+S3method(summary,gsplot)
 S3method(xlim,gsplot)
 S3method(ylim,gsplot)
 export("%>%")

R/access-gsplot.R

@@ -95,5 +95,12 @@ view_info <- function(object){
 
   viewInfo[,c("x","y","index")] <- sapply(viewInfo[,c("x","y","index")], function(x) as.integer(x))
 
+  i <- which(names(object) %in% 'axis')
+  definded.sides <- sapply(i, function(x) object[[x]][['arguments']][['side']])
+  view.sides.drawn <- NULL
+
+  viewInfo$x.side.defined.by.user <- viewInfo$x %in% definded.sides
+  viewInfo$y.side.defined.by.user <- viewInfo$y %in% definded.sides
+
   return(viewInfo)
 }

R/axis.R

@@ -17,12 +17,13 @@
 #' gs <- gsplot() %>%
 #'    points(x=1:5, y=1:5, legend.name="Stuff") %>%
 #'    lines(2:6, y=2:6, ylim=c(0,10)) %>%
+#'    bgCol(col="lightgoldenrod") %>%
 #'    axis(side=c(3,4),labels=FALSE) %>%
 #'    legend("topright")
 #' gs
 #' 
 #' gs <- gsplot() %>%
-#'    points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA)) %>%
+#'    points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA),las=0) %>%
 #'    axis(side=c(4), labels=FALSE) %>%
 #'    axis(side=c(1,3), n.minor=4)
 #' gs
@@ -34,8 +35,8 @@
 #' gs
 #' 
 #' gs <- gsplot() %>%
-#'    points(1:5, c(1,10,100,1000,10000), log="y", las=1) %>%
-#'    axis(side=c(2,4), n.minor=4)
+#'    points(1:5, c(1,10,100,1000,10000), log="y") %>%
+#'    axis(side=c(2,4), n.minor=4, las=1)
 #' gs
 #' 
 #' gs <- gsplot() %>%

R/bgCol.R

@@ -10,23 +10,38 @@
 #' @examples
 #' gs <- gsplot() %>%
 #'    points(y=c(3,1,2), x=4:6, xlim=c(0,NA),legend.name="Points") %>%
+#'    bgCol(col="lightgrey") %>%
 #'    lines( c(3,4,3), c(2,4,6), legend.name="Lines", side=c(3,4)) %>%
-#'    legend(location="topleft") %>%
-#'    bgCol(col="lightgrey") 
-#'     
+#'    legend(location="topleft")      
 #' gs
 #' 
-#' gsPlain <- gsplot()%>%
+#' gs <- gsplot() %>%
 #'    points(1:100, rnorm(100,mean=10000, sd=1000), log="y") %>%
 #'    bgCol(col="lightgrey")
-#' gsPlain
+#' gs
+#' 
+#' gs <- gsplot() %>%
+#'    points(1:100, rnorm(100,mean=10000, sd=1000), log="y") %>%
+#'    bgCol() #yaml specifies lightgrey
+#' gs
+#' 
+#' gs <- gsplot() %>%
+#'    points(1:100, rnorm(100,mean=10000, sd=1000), log="y") %>%
+#'    bgCol("lightgoldenrod") 
+#' gs
 bgCol <- function(object, ...) {
   override("gsplot", "bgCol", object, ...)
 }
 
 
-bgCol.gsplot <- function(object, ..., side=c(1,2)){
-  set_window_args(object, fun.name="bgCol", ..., legend.name=NULL, side=side, package='gsplot')
+bgCol.gsplot <- function(object, ...){
+
+  to.gsplot <- set_args("bgCol",..., package = "gsplot")
+
+  to.gsplot <- list("bgCol"=to.gsplot)
+
+  object <- append(object, to.gsplot)
+  return(gsplot(object))
 }
 
 bgCol.default <- function(col,...){

R/calc_views.R

@@ -186,6 +186,7 @@ c_unname <- function(list){
 unname_c <- function(list){
   do.call(c, unname(list))
 }
+
 views_with_side <- function(views, side){
   if(length(side) > 1)
     stop('side can only be length of 1')

R/grid.R

@@ -15,11 +15,86 @@
 #' gsNew <- abline(gsNew, b=1, a=0, legend.name="1:1")
 #' gsNew <- legend(gsNew, location="topleft",title="Awesome!")
 #' gsNew
+#' 
+#' gs <- gsplot() %>%
+#'        points(1:10,1:10) %>%
+#'        lines(6:14,6:14,side=c(3,4)) %>%
+#'        grid(side=c(3,4))
+#' gs
+#' 
+#' gs <- gsplot() %>%
+#'        points(1:10,1:10) %>%
+#'        axis(side=1, at=seq(1,10,length.out=18),las=3) %>%
+#'        axis(side=3, labels=FALSE) %>%
+#'        grid(side=c(1,2),col="green") %>%
+#'        grid(side=c(3,4))
+#' gs
+#' 
+#' gs <- gsplot() %>%
+#'       points(x=seq.Date(as.Date("2000-01-01"),as.Date("2010-01-01"),length.out = 20),
+#'              y=1:20,axes=FALSE) %>%
+#'      grid()
+#' gs
+#'
+#' gs <- gsplot() %>% 
+#'      points(x=1:10, y=1:10) %>% 
+#'      grid(lty=3, col="gray") %>%
+#'      axis(side=2, reverse=TRUE) 
+#' gs
 grid <- function(object, ...) {
   override("graphics", "grid", object, ...)
 }
 
-
 grid.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  set_window_args(object, fun.name='grid', ..., legend.name=legend.name, side=side, def.funs = graphics::grid)
+
+  object <- set_window_args(object, fun.name='grid', ..., legend.name=legend.name, side=side, def.funs = graphics::grid)
+
+}
+
+draw_custom_grid <- function(object, index){
+
+  i <- which(names(object) %in% 'axis')
+  definded.sides <- sapply(i, function(x) object[[x]][['arguments']][['side']])
+
+  window = object[[index]][['window']]
+
+  view.info <- view_info(object)
+  view.info <- view.info[index == view.info$index,]
+
+  grid.args <- set_args("grid",object[[index]][['grid']], package = "graphics")
+
+  if(class(window$xlim) %in% c("numeric","integer")){
+    x.at <- axTicks(view.info$x)
+  } else if (class(window$xlim) == "Date"){
+    x.at <- axis.Date(view.info$x,window$xlim)
+  } else if (class(window$xlim) == "POSIXct"){
+    x.at <- axis.POSIXct(view.info$x,window$xlim)
+  }
+
+  if(view.info$x.side.defined.by.user){
+    axes.index <- i[definded.sides == view.info$x]
+    x <- object[axes.index][['axis']][['arguments']][['at']]
+    if(!is.null(x)){
+      x.at <-x
+    }
+  }
+
+  if(class(window$ylim) %in% c("numeric","integer")){
+    y.at <- axTicks(view.info$y)
+  } else if (class(window$ylim) == "Date"){
+    y.at <- axis.Date(view.info$y,window$ylim)
+  } else if (class(window$ylim) == "POSIXct"){
+    y.at <- axis.POSIXct(view.info$y,window$ylim)
+  }
+
+  if(view.info$y.side.defined.by.user){
+    axes.index <- i[definded.sides == view.info$y]
+    y <- object[axes.index][['axis']][['arguments']][['at']]
+    if(!is.null(y)){
+      y.at <- y
+    }
+  }
+  grid.args <- grid.args[names(grid.args) != "equilogs"] 
+  abline(h=y.at, v=x.at, grid.args)
+
 }

R/gsplot-class.R

@@ -26,3 +26,35 @@ gsplot.list <- function(x){
   class(x) <- "gsplot"
   invisible(x) 
 }
+
+#' Summary of gsplot object
+#'
+#' Summary information
+#'
+#' @param object list
+#' @param \dots additional parameters
+#' @export
+#' @examples 
+#' gs <- gsplot() %>%
+#'        points(1:10,1:10) %>%
+#'        axis(side=1, at=seq(1,10,length.out=18),las=3) %>%
+#'        axis(side=3, labels=FALSE) %>%
+#'        grid(side=c(1,2),col="green") %>%
+#'        grid(side=c(3,4))
+#' summary(gs)
+summary.gsplot <- function(object,...){
+
+  view.info <- view_info(object)
+  cat("Summary information of plotting object:\n")
+  cat(nrow(view.info),"views:\n")
+  for(i in seq_len(nrow(view.info))){
+    cat("View:",i,"\nx side:", view.info$x[i], ",y side:", view.info$y[i], "\n")
+    cat("xlim:",as.numeric(xlim(object, side=view.info$x[i])[[1]]),",")
+    cat("ylim:",as.numeric(ylim(object, side=view.info$y[i])[[1]]))
+    if(view.info$log[i] != ""){
+      cat(",log:",view.info$log[i])
+    }
+    cat("\n")
+  }
+}
+

R/print.R

@@ -43,10 +43,13 @@ print.gsplot <- function(x, ...){
   i <- which(names(views) %in% 'axis')
   definded.sides <- sapply(i, function(x) views[[x]][['arguments']][['side']])
 
+  bg.arg <- views$bgCol
+  title.arg <- views$title
+
   view.info <- view_info(views)
-  view.sides.drawn <- NULL
+  view.index <- view.info$index
 
-  for (i in which(names(views) %in% 'view')){
+  for (i in view.index){
 
     plots = views[[i]]
     plots[['window']] <- NULL
@@ -57,31 +60,38 @@ print.gsplot <- function(x, ...){
     par(window[['par']])
     plot.window(xlim = window$xlim, ylim = window$ylim, log = view.info$log[i==view.info$index])
 
-    sides.not.defined <- window$side[!(window$side %in% definded.sides)]
-
-    if(!is.null(view.sides.drawn)){
-      view.sides.drawn <- sides.not.defined[-view.sides.drawn]
+    # -- initial view --
+    if(i == view.index[1]){
+      bgCol(bg.arg)
+      title(title.arg)
     }
 
+    # -- call functions -- 
+
+    if((sum(view.info$x.side.defined.by.user[i], view.info$y.side.defined.by.user[i])== 0 ) &
+       (class(window$xlim) == "numeric" & class(window$ylim) == "numeric") | 
+       !(any(names(plots) %in% 'grid'))){
+      to_gsplot(lapply(plots, function(x) x[!names(x) %in% 'legend.name']))
+    } else {
+      draw_custom_grid(views,i)
+      plots <- plots[!(names(plots) %in% 'grid')]
+      to_gsplot(lapply(plots, function(x) x[!(names(x) %in% c('legend.name'))]))
+    }
+
     if(window$axes){
-      for(j in sides.not.defined){
-        if(j %% 2 != 0){
-          Axis(side=j,x=window$xlim)
-        } else {
-          Axis(side=j,x=window$ylim) 
-        }
-        view.sides.drawn <- append(view.sides.drawn, j)
+      if(!view.info$x.side.defined.by.user[i]){
+        Axis(side=view.info$x[i],x=window$xlim)
+      }
+      if(!view.info$y.side.defined.by.user[i]){
+        Axis(side=view.info$y[i],x=window$ylim)
       }
     } 
 
     if(window$ann){
-      mtext(text=window$xlab, side=window$side[1], line = 2)
-      mtext(text=window$ylab, side=window$side[2], line = 2)        
+      mtext(text=window$xlab, side=window$side[1], line = 2, las=config("mtext")$las)
+      mtext(text=window$ylab, side=window$side[2], line = 2, las=config("mtext")$las)        
     }
 
-    # -- call functions -- 
-    to_gsplot(lapply(plots, function(x) x[!names(x) %in% 'legend.name']))
-
     par(new=TRUE)
   }
 

R/title.R

@@ -16,18 +16,28 @@
 #'  
 #' @export
 #' @examples
-#' gs <- gsplot()
-#' gsNew <- points(gs, y=1, x=2, col="blue", pch=18, legend.name="Points", xlab="Stuff")
-#' gsNew <- lines(gsNew, c(3,4,3), c(2,4,6), legend.name="Lines", ylab="Data!")
-#' gsNew <- abline(gsNew, b=1, a=0, legend.name="1:1")
-#' gsNew <- legend(gsNew, location="topleft",title="Awesome!")
-#' gsNew <- title(gsNew, main="Great Graph", col.main="grey", font.main=2, cex.main=2)
-#' gsNew
+#' gs <- gsplot() %>%
+#'       points(y=1, x=2, col="blue", pch=18, legend.name="Points", xlab="Stuff") %>%
+#'       lines(c(3,4,3), c(2,4,6), legend.name="Lines", ylab="Data!") %>%
+#'       abline(b=1, a=0, legend.name="1:1") %>%
+#'       legend(location="topleft",title="Awesome!") %>%
+#'       title(main="Great Graph", col.main="grey", font.main=2, cex.main=2)
+#' gs
+#' gs <- gsplot() %>%
+#'       points(y=1, x=2) %>%
+#'       title(main="Great Graph")
+#' gs
 title <- function(object, ...) {
   override("graphics", "title", object, ...)
 }
 
 
 title.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  set_window_args(object, fun.name='title', ..., legend.name=legend.name, side=side, def.funs=graphics::title)
+  to.gsplot <- set_args("title",..., package = "graphics")
+
+  to.gsplot <- list("title"=to.gsplot)
+
+  object <- append(object, to.gsplot)
+  return(gsplot(object))
+  # set_window_args(object, fun.name='title', ..., legend.name=legend.name, side=side, def.funs=graphics::title)
 }

README.Rmd

@@ -34,7 +34,7 @@ library(gsplot)
 demoPlot <- gsplot() %>%
   points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA),
          col="blue", pch=18, legend.name="Points", xlab="Index") %>%
-  lines(c(3,4,3), c(2,4,6), legend.name="Lines", ylab="Data") %>%
+  lines(c(3,4,3), c(2,4,6), legend.name="Lines", ylab=expression(paste("Data [ft"^"3","/s]"))) %>%
   abline(b=1, a=0, legend.name="1:1") %>%
   axis(side=c(3,4), labels=FALSE) %>%
   legend(location="topleft",title="Awesome!") %>%
@@ -47,11 +47,11 @@ demoPlot
 ```
 
 ```{r echo=TRUE, warning=FALSE, message=FALSE}
-library(gsplot)
-
 gs <- gsplot() %>%
-  points(y=c(3,1,2,4,5), x=c(1:3,8,80), col="blue", pch=18, legend.name="Points") %>%
-  lines(c(3,4,3), c(2,4,6), legend.name="Lines", ylab="logged y axis", xlab="logged x axis", log='xy') %>%
+  points(y=c(3,1,2,4,5), x=c(1:3,8,80), 
+         col="blue", pch=18, legend.name="Points") %>%
+  lines(c(3,4,3), c(2,4,6), legend.name="Lines", 
+        ylab="logged y axis", xlab="logged x axis", log='xy') %>%
   callouts(x=8, y=4, lwd=2, angle=45, labels="Not sure about this one") %>%
   title("logged axes") %>%
   axis(side=c(1,2,3,4), labels=FALSE, n.minor=4) %>%
@@ -60,7 +60,6 @@ gs
 ```
 
 ```{r echo=TRUE, warning=FALSE, message=FALSE}
-library(gsplot)
 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, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red", ylab=expression(paste("Discharge in ",ft^3/s))) %>%