Merge pull request #70 from ldecicco-USGS/master

Abline

.Rbuildignore

@@ -1,4 +1,7 @@
 appveyor.yml
 .travis.yml
+README.Rmd
+README_files
+test.png
 ^.*\.Rproj$
 ^\.Rproj\.user$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gsplot
 Type: Package
-Title: Geological Survey plotting
+Title: Geological Survey Plotting
 Version: 0.0.1
 Date: 2015-06-24
 Author: CIDA
@@ -15,7 +15,11 @@ Copyright: This software is in the public domain because it contains materials
     official USGS copyright policy at
     http://www.usgs.gov/visual-id/credit_usgs.html#copyright
 Imports:
-    magrittr
+    magrittr,
+    stats,
+    graphics,
+    utils,
+    methods
 Suggests:
     testthat,
     knitr

NAMESPACE

@@ -11,4 +11,12 @@ export(legend)
 export(lines)
 export(loadConfig)
 export(points)
+importFrom(graphics,box)
+importFrom(graphics,mtext)
+importFrom(graphics,par)
+importFrom(graphics,plot.new)
+importFrom(graphics,plot.xy)
 importFrom(magrittr,"%>%")
+importFrom(methods,existsFunction)
+importFrom(stats,setNames)
+importFrom(utils,getFromNamespace)

R/abline.R

@@ -8,19 +8,26 @@
 #' @param \dots Further graphical parameters may also be supplied as arguments. See 'Details'.
 #' @return modified gsplot object 
 #' @export
+#' @examples
+#' gs <- gsplot()
+#' gsNew <- points(gs, y=1, x=2, col="blue", pch=18, legend.name="Points")
+#' gsNew <- lines(gsNew, c(3,4,3), c(2,4,6), legend.name="Lines")
+#' gsNew <- abline(gsNew, b=1, a=0, legend.name="1:1")
+#' gsNew <- legend(gsNew, "topleft",title="Awesome!")
+#' gsNew
 abline <- function(object, ...) {
   overrideGraphics("abline", object, ...)
 }
 
 
-abline.gsplot <- function(object, x, y=NULL, ..., legend.name=NULL, side=c(1,2)){
+abline.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
   current_list <- config("abline")
-  arguments <- list(x=x, y=y, ...)
+  arguments <- list(...)
 
   indicesToAdd <- !(names(current_list) %in% names(arguments))
   arguments <- append(arguments, current_list[indicesToAdd])
 
-  object <- append(object,  list(points = list(arguments = arguments, 
+  object <- append(object,  list(abline = list(arguments = arguments, 
                                                gs.config=list(legend.name = legend.name, 
                                                               side = side))))
   return(gsplot(object))

R/calc_views.R

@@ -5,6 +5,7 @@
 #'
 #' @param gsplot object
 #' @export
+#' @importFrom graphics par
 #' @keywords internal
 calc_views <- function(gsplot){
 

R/config.R

@@ -10,37 +10,12 @@
 #'@examples
 #'loadConfig()
 #'@export
+#' @importFrom graphics plot.xy
+#' @importFrom graphics par
 loadConfig = function(filename) {
 
   if(missing(filename)){
-
-#     graphTemplate <- list(
-#       points = list(
-#         pch=19,
-#         lwd=1
-#       ),
-#       lines = list(
-#         lty=1,
-#         lwd=2
-#       ),
-#       axis = list(
-#         xaxs="i",
-#         yaxs="i", 
-#         tcl=0.5,
-#         mgp=c(3,1,0)
-#       )
-#     ) 
-
-
-
-#     graphTemplate <- list(
-#       pch=c(19,15,17,18,21,22,24,23),
-#       xaxs="i",
-#       yaxs="i",
-#       tcl=0.5,
-#       mgp=c(3,1,0),
-#       lty=c(1,2,3,4,5,6,1,2 )
-#     ) 
+
     graphTemplate <- list(
       pch=19,
       xaxs="i",
@@ -52,7 +27,10 @@ loadConfig = function(filename) {
       grid=list(lty=2,
                 col="grey"),
       points=list(pch=6,col="red"),
-      lines=list()
+      lines=list(),
+      abline=list(col="grey"),
+      legend=list(),
+      axis=list()
     )
 
   } else {
@@ -62,63 +40,38 @@ loadConfig = function(filename) {
 }
 
 
-config <- function(type=c("par","points","lines","axis","plot"),...){
+config <- function(type,...){
 
   loadConfig()
-
-  type <- match.arg(type)
-
-  config_list <- options("gsplot")[[1]]
-
-  globalConfig <- config_list[!(names(config_list) %in% c("points","lines","grid"))]
-
-  if(type %in% c("par")){
-    formalsNames <- names(par(no.readonly = TRUE))
-    formalsNames <- formalsNames[formalsNames != "..."]
-  }
 
-  if(type %in% c("points")){
-    formalsNames <- names(formals(plot.xy))
-    formalsNames <- formalsNames[formalsNames != "..."]
-    globalConfig[names(config_list$points)] <- NULL
-    globalConfig <- append(globalConfig, config_list$points)
-  }
+  allowedTypes <- c("par","points","lines","axis","plot","abline","grid","legend")
 
-  if(type %in% c("lines")){
-    formalsNames <- names(formals(plot.xy))
-    formalsNames <- formalsNames[formalsNames != "..."]
-    globalConfig[names(config_list$lines)] <- NULL
-    globalConfig <- append(globalConfig, config_list$lines)
-  }
+  type <- match.arg(type, choices = allowedTypes)
 
-  if(type %in% c("plot")){
-    formalsNames <- names(formals(plot.xy))
-    formalsNames <- formalsNames[formalsNames != "..."]
-  }
+  config_list <- options("gsplot")[[1]]
 
-  if(type %in% c("axis")){
-    formalsNames <- names(formals(graphics::axis))
-    formalsNames <- formalsNames[formalsNames != "..."]
-  }
+  globalConfig <- config_list[!(names(config_list) %in% allowedTypes[allowedTypes != "par"])]
 
-  if(type %in% c("legend")){
-    formalsNames <- names(formals(graphics::legend))
-    formalsNames <- formalsNames[formalsNames != "..."]
-  }
+  formalsNames <- names(formals(plot.xy))
+  formalsNames <- switch(type,
+                         par=names(par(no.readonly = TRUE)),
+                         axis=names(formals(graphics::axis)),
+                         legend=names(formals(graphics::legend)),
+                         grid=names(formals(graphics::grid)),
+                         abline=names(formals(graphics::abline)),
+                         formalsNames)
 
-  if(type %in% c("grid")){
-    formalsNames <- names(formals(graphics::grid))
-    formalsNames <- formalsNames[formalsNames != "..."]
-    globalConfig[names(config_list$grid)] <- NULL
-    globalConfig <- append(globalConfig, config_list$grid)
-  }
+  formalsNames <- formalsNames[formalsNames != "..."]
 
   globalConfig <- globalConfig[names(globalConfig) %in% formalsNames]
 
+  if(type %in% names(config_list)){
+    globalConfig[names(config_list[[type]])] <- NULL
+    globalConfig <- append(globalConfig, config_list[[type]])
+  }
   globalConfig[names(list(...))] <- NULL
   globalConfig <- append(globalConfig, list(...))
 
-
   return(globalConfig)
 
 }

R/gsplot-class.R

@@ -5,14 +5,17 @@
 #' @param x list
 #' @return gsplot 
 #' @export
+#' @importFrom utils getFromNamespace
+#' @importFrom stats setNames
+#' @importFrom methods existsFunction
 #' @examples
-#' gsplot(list())
-gsplot <- function(x){
+#' gsplot()
+gsplot <- function(x=list()){
   UseMethod("gsplot", x)
 }
 
 #' @export
-gsplot.list <- function(x){
+gsplot.list <- function(x=list()){
   class(x) <- "gsplot"
   invisible(x) 
 }

R/legend.R

@@ -7,66 +7,80 @@
 #' @param \dots normal legend params should forward through
 #' @return modified gsplot object 
 #' @export
+#' @importFrom graphics par
 #' @examples
-#' bottom <- gsplot(list()) %>% 
-#'  points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>% 
-#'  points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>% 
+#' bottom <- gsplot() %>% 
+#'  points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>% 
+#'  points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>% 
 #'  legend(location="bottom")
 #' bottom
 #' 
-#' topright <- gsplot(list()) %>% 
-#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines", lty=5, col="orange") %>% 
-#'  points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>% 
-#'  points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>% 
+#' topright <- gsplot() %>% 
+#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines", lty=5, col="orange") %>% 
+#'  points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>% 
+#'  points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>% 
 #'  legend(location="topright", title="LEGEND!!!")
 #' topright
 #' 
-#' defaultLegend <- gsplot(list()) %>% 
+#' defaultLegend <- gsplot() %>% 
 #'  points(x=1, y=2, side=c(3,2)) %>% 
 #'  points(x=3, y=4, side=c(1,4)) %>% 
 #'  lines(x=c(3,4,3), y=c(2,4,6)) %>%
 #'  lines(x=c(1,2,5), y=c(1,8,5)) %>%  
 #'  legend()
 #' defaultLegend
 #' 
-#' above <- gsplot(list()) %>% 
-#'  points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>% 
-#'  points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>% 
-#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines 1", lty=5, col="orange") %>%
-#'  lines(x=c(1,2,5), y=c(1,8,5), legend.name="Example Lines 2", lty=5, col="green") %>%  
+#' above <- gsplot() %>% 
+#'  points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>% 
+#'  points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>% 
+#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5, col="orange") %>%
+#'  lines(x=c(1,2,5), y=c(1,8,5), legend.name="Lines 2", lty=5, col="green") %>%  
 #'  legend(location="above")
 #' above
 #' 
-#' below <- gsplot(list()) %>% 
-#'  points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>% 
-#'  points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>% 
-#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines 1", lty=5, col="orange") %>%
-#'  lines(x=c(1,2,5), y=c(1,8,5), legend.name="Example Lines 2", lty=5, col="green") %>% 
+#' below <- gsplot() %>% 
+#'  points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>% 
+#'  points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>% 
+#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5, col="orange") %>%
+#'  lines(x=c(1,2,5), y=c(1,8,5), legend.name="Lines 2", lty=5, col="green") %>% 
 #'  legend(location="below")
 #' below
 #' 
-#' toright <- gsplot(list()) %>% 
-#'  points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>% 
-#'  points(x=3, y=4, side=c(1,4), legend.name="Example Points 1", pch=1, col="blue") %>% 
-#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines 1", lty=5) %>%
-#'  lines(x=c(1,2,5), y=c(1,8,5), legend.name="Example Lines 2", lty=5, col="green") %>% 
+#' toright <- gsplot() %>% 
+#'  points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>% 
+#'  points(x=3, y=4, side=c(1,4), legend.name="Points 1", pch=1, col="blue") %>% 
+#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5) %>%
+#'  lines(x=c(1,2,5), y=c(1,8,5), legend.name="Lines 2", lty=5, col="green") %>% 
 #'  legend(location="toright")
 #' toright
 #' 
-#' toleft <- gsplot(list()) %>% 
-#'  points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>% 
-#'  points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>% 
-#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines 1", lty=5, col="orange") %>%
+#' toleft <- gsplot() %>% 
+#'  points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>% 
+#'  points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>% 
+#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5, col="orange") %>%
 #'  lines(x=c(1,2,5), y=c(1,8,5), lty=5, col="green") %>% 
 #'  legend(location="below")
 #' toleft
+#' 
+#' usrDef <- gsplot() %>% 
+#'  points(x=1, y=2, side=c(3,2), legend.name="Points 1", cex=3) %>% 
+#'  points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>% 
+#'  lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5, col="orange") %>%
+#'  lines(x=c(1,2,5), y=c(1,8,5), legend.name="Lines 2", lwd=3) %>%  
+#'  legend(x=3,y=4)
+#' usrDef
 legend <- function(object, ...){
   overrideGraphics("legend", object, ...)
 }
 
 
 legend.gsplot <- function(object, location="topright", legend_offset=0.3, ...) {
   arguments <- list(...)
+
+  if("x" %in% names(arguments)){
+    location <- arguments$x
+  }
+
   gsConfig <- list(location = location, legend_offset = legend_offset)
 
   arguments <- appendLegendPositionConfiguration(location, gsConfig, arguments)
@@ -88,6 +102,8 @@ appendLegendPositionConfiguration <- function(location, gsConfig, arguments) {
     return(append(arguments, list(x = "right", y = NULL, inset=c(-legend_offset, 0), bty="n")))
   } else if(location == "toleft") {
     return(append(arguments, list(x = "left", y = NULL, inset=c(-legend_offset, 0), bty="n")))
+  } else if("x" %in% names(arguments)){
+    return(arguments)
   } else {
     return(append(arguments, list(x = location)))
   }
@@ -137,7 +153,7 @@ draw_legend <- function(gsplot) {
     }
 
     #get legend entries for lines
-    lines_i <- which(names(gsplot) %in% 'lines')
+    lines_i <- which(names(gsplot) %in% c('lines','abline'))
     for (i in lines_i){
       lines <- gsplot[[i]]
       if(all((c("lty","col") %in% names(lines[['arguments']])))){
@@ -152,6 +168,11 @@ draw_legend <- function(gsplot) {
 
     smartLegend <- unique(smartLegend)
 
+    lineTypes <- c("blank", "solid", "dashed", "dotted", "dotdash", "longdash", "twodash")
+
+    lineNums <- suppressWarnings(as.numeric(smartLegend$line))
+    smartLegend$line[!is.na(lineNums)] <- lineTypes[lineNums+1][!is.na(lineTypes[lineNums+1])]
+
     if(nrow(smartLegend) > 0){
 
       #only include pch if we have a non-NA entry for points

R/lines.R

@@ -5,13 +5,13 @@
 #' @param \dots Further graphical parameters may also be supplied as arguments. See 'Details'.
 #' @return modified gsplot object 
 #' @examples
-#' gsNew <- gsplot(list())
+#' gsNew <- gsplot()
 #' gsNew <- lines(gsNew, c(1,2), y=c(2,5))
 #' gsNew <- lines(gsNew, c(3,4,3), c(2,4,6), pch=6)
 #' gsNew <- points(gsNew, c(8,4,1.2), c(2,4.7,6), side=c(3,2))
 #' gsNew
 #' 
-#' gsNewpipe <- gsplot(list()) %>%
+#' gsNewpipe <- gsplot() %>%
 #'    lines(c(1,2), c(2,5)) %>%
 #'    lines(c(3,4,3), c(2,4,6), pch=6) %>%
 #'    points(c(8,4,1.2), c(2,4.7,6), side=c(3,2))

R/points.R

@@ -8,7 +8,7 @@
 #' @param \dots Further graphical parameters may also be supplied as arguments. See 'Details'.
 #' @return modified gsplot object 
 #' @examples
-#' gs <- gsplot(list())
+#' gs <- gsplot()
 #' gsNew <- points(gs, y=1, x=2, col="blue", pch=18)
 #' gsNew <- points(gsNew, c(3,4,3), c(2,4,6), ylim=c(0,10))
 #' gsNew