Skip to content

Commit fa2e456

Browse files
author
Jordan S Read
committed
Merge pull request #70 from ldecicco-USGS/master
Abline
2 parents 4edaf7f + 5303eeb commit fa2e456

File tree

21 files changed

+259
-174
lines changed

21 files changed

+259
-174
lines changed

‎.Rbuildignore‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,7 @@
11
appveyor.yml
22
.travis.yml
3+
README.Rmd
4+
README_files
5+
test.png
36
^.*\.Rproj$
47
^\.Rproj\.user$

‎DESCRIPTION‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: gsplot
22
Type: Package
3-
Title: Geological Survey plotting
3+
Title: Geological Survey Plotting
44
Version: 0.0.1
55
Date: 2015-06-24
66
Author: CIDA
@@ -15,7 +15,11 @@ Copyright: This software is in the public domain because it contains materials
1515
official USGS copyright policy at
1616
http://www.usgs.gov/visual-id/credit_usgs.html#copyright
1717
Imports:
18-
magrittr
18+
magrittr,
19+
stats,
20+
graphics,
21+
utils,
22+
methods
1923
Suggests:
2024
testthat,
2125
knitr

‎NAMESPACE‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,4 +11,12 @@ export(legend)
1111
export(lines)
1212
export(loadConfig)
1313
export(points)
14+
importFrom(graphics,box)
15+
importFrom(graphics,mtext)
16+
importFrom(graphics,par)
17+
importFrom(graphics,plot.new)
18+
importFrom(graphics,plot.xy)
1419
importFrom(magrittr,"%>%")
20+
importFrom(methods,existsFunction)
21+
importFrom(stats,setNames)
22+
importFrom(utils,getFromNamespace)

‎R/abline.R‎

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -8,19 +8,26 @@
88
#' @param \dots Further graphical parameters may also be supplied as arguments. See 'Details'.
99
#' @return modified gsplot object
1010
#' @export
11+
#' @examples
12+
#' gs <- gsplot()
13+
#' gsNew <- points(gs, y=1, x=2, col="blue", pch=18, legend.name="Points")
14+
#' gsNew <- lines(gsNew, c(3,4,3), c(2,4,6), legend.name="Lines")
15+
#' gsNew <- abline(gsNew, b=1, a=0, legend.name="1:1")
16+
#' gsNew <- legend(gsNew, "topleft",title="Awesome!")
17+
#' gsNew
1118
abline <- function(object, ...) {
1219
overrideGraphics("abline", object, ...)
1320
}
1421

1522

16-
abline.gsplot <- function(object, x, y=NULL, ..., legend.name=NULL, side=c(1,2)){
23+
abline.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
1724
current_list <- config("abline")
18-
arguments <- list(x=x, y=y, ...)
25+
arguments <- list(...)
1926

2027
indicesToAdd <- !(names(current_list) %in% names(arguments))
2128
arguments <- append(arguments, current_list[indicesToAdd])
2229

23-
object <- append(object, list(points = list(arguments = arguments,
30+
object <- append(object, list(abline = list(arguments = arguments,
2431
gs.config=list(legend.name = legend.name,
2532
side = side))))
2633
return(gsplot(object))

‎R/calc_views.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
#'
66
#' @param gsplot object
77
#' @export
8+
#' @importFrom graphics par
89
#' @keywords internal
910
calc_views <- function(gsplot){
1011

‎R/config.R‎

Lines changed: 25 additions & 72 deletions
Original file line numberDiff line numberDiff line change
@@ -10,37 +10,12 @@
1010
#'@examples
1111
#'loadConfig()
1212
#'@export
13+
#' @importFrom graphics plot.xy
14+
#' @importFrom graphics par
1315
loadConfig = function(filename) {
1416

1517
if(missing(filename)){
16-
17-
# graphTemplate <- list(
18-
# points = list(
19-
# pch=19,
20-
# lwd=1
21-
# ),
22-
# lines = list(
23-
# lty=1,
24-
# lwd=2
25-
# ),
26-
# axis = list(
27-
# xaxs="i",
28-
# yaxs="i",
29-
# tcl=0.5,
30-
# mgp=c(3,1,0)
31-
# )
32-
# )
33-
34-
35-
36-
# graphTemplate <- list(
37-
# pch=c(19,15,17,18,21,22,24,23),
38-
# xaxs="i",
39-
# yaxs="i",
40-
# tcl=0.5,
41-
# mgp=c(3,1,0),
42-
# lty=c(1,2,3,4,5,6,1,2 )
43-
# )
18+
4419
graphTemplate <- list(
4520
pch=19,
4621
xaxs="i",
@@ -52,7 +27,10 @@ loadConfig = function(filename) {
5227
grid=list(lty=2,
5328
col="grey"),
5429
points=list(pch=6,col="red"),
55-
lines=list()
30+
lines=list(),
31+
abline=list(col="grey"),
32+
legend=list(),
33+
axis=list()
5634
)
5735

5836
} else {
@@ -62,63 +40,38 @@ loadConfig = function(filename) {
6240
}
6341

6442

65-
config <- function(type=c("par","points","lines","axis","plot"),...){
43+
config <- function(type,...){
6644

6745
loadConfig()
68-
69-
type <- match.arg(type)
70-
71-
config_list <- options("gsplot")[[1]]
72-
73-
globalConfig <- config_list[!(names(config_list) %in% c("points","lines","grid"))]
74-
75-
if(type %in% c("par")){
76-
formalsNames <- names(par(no.readonly = TRUE))
77-
formalsNames <- formalsNames[formalsNames != "..."]
78-
}
7946

80-
if(type %in% c("points")){
81-
formalsNames <- names(formals(plot.xy))
82-
formalsNames <- formalsNames[formalsNames != "..."]
83-
globalConfig[names(config_list$points)] <- NULL
84-
globalConfig <- append(globalConfig, config_list$points)
85-
}
47+
allowedTypes <- c("par","points","lines","axis","plot","abline","grid","legend")
8648

87-
if(type %in% c("lines")){
88-
formalsNames <- names(formals(plot.xy))
89-
formalsNames <- formalsNames[formalsNames != "..."]
90-
globalConfig[names(config_list$lines)] <- NULL
91-
globalConfig <- append(globalConfig, config_list$lines)
92-
}
49+
type <- match.arg(type, choices = allowedTypes)
9350

94-
if(type %in% c("plot")){
95-
formalsNames <- names(formals(plot.xy))
96-
formalsNames <- formalsNames[formalsNames != "..."]
97-
}
51+
config_list <- options("gsplot")[[1]]
9852

99-
if(type %in% c("axis")){
100-
formalsNames <- names(formals(graphics::axis))
101-
formalsNames <- formalsNames[formalsNames != "..."]
102-
}
53+
globalConfig <- config_list[!(names(config_list) %in% allowedTypes[allowedTypes != "par"])]
10354

104-
if(type %in% c("legend")){
105-
formalsNames <- names(formals(graphics::legend))
106-
formalsNames <- formalsNames[formalsNames != "..."]
107-
}
55+
formalsNames <- names(formals(plot.xy))
56+
formalsNames <- switch(type,
57+
par=names(par(no.readonly = TRUE)),
58+
axis=names(formals(graphics::axis)),
59+
legend=names(formals(graphics::legend)),
60+
grid=names(formals(graphics::grid)),
61+
abline=names(formals(graphics::abline)),
62+
formalsNames)
10863

109-
if(type %in% c("grid")){
110-
formalsNames <- names(formals(graphics::grid))
111-
formalsNames <- formalsNames[formalsNames != "..."]
112-
globalConfig[names(config_list$grid)] <- NULL
113-
globalConfig <- append(globalConfig, config_list$grid)
114-
}
64+
formalsNames <- formalsNames[formalsNames != "..."]
11565

11666
globalConfig <- globalConfig[names(globalConfig) %in% formalsNames]
11767

68+
if(type %in% names(config_list)){
69+
globalConfig[names(config_list[[type]])] <- NULL
70+
globalConfig <- append(globalConfig, config_list[[type]])
71+
}
11872
globalConfig[names(list(...))] <- NULL
11973
globalConfig <- append(globalConfig, list(...))
12074

121-
12275
return(globalConfig)
12376

12477
}

‎R/gsplot-class.R‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -5,14 +5,17 @@
55
#' @param x list
66
#' @return gsplot
77
#' @export
8+
#' @importFrom utils getFromNamespace
9+
#' @importFrom stats setNames
10+
#' @importFrom methods existsFunction
811
#' @examples
9-
#' gsplot(list())
10-
gsplot <- function(x){
12+
#' gsplot()
13+
gsplot <- function(x=list()){
1114
UseMethod("gsplot", x)
1215
}
1316

1417
#' @export
15-
gsplot.list <- function(x){
18+
gsplot.list <- function(x=list()){
1619
class(x) <- "gsplot"
1720
invisible(x)
1821
}

‎R/legend.R‎

Lines changed: 49 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -7,66 +7,80 @@
77
#' @param \dots normal legend params should forward through
88
#' @return modified gsplot object
99
#' @export
10+
#' @importFrom graphics par
1011
#' @examples
11-
#' bottom <- gsplot(list()) %>%
12-
#' points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>%
13-
#' points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>%
12+
#' bottom <- gsplot() %>%
13+
#' points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>%
14+
#' points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>%
1415
#' legend(location="bottom")
1516
#' bottom
1617
#'
17-
#' topright <- gsplot(list()) %>%
18-
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines", lty=5, col="orange") %>%
19-
#' points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>%
20-
#' points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>%
18+
#' topright <- gsplot() %>%
19+
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines", lty=5, col="orange") %>%
20+
#' points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>%
21+
#' points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>%
2122
#' legend(location="topright", title="LEGEND!!!")
2223
#' topright
2324
#'
24-
#' defaultLegend <- gsplot(list()) %>%
25+
#' defaultLegend <- gsplot() %>%
2526
#' points(x=1, y=2, side=c(3,2)) %>%
2627
#' points(x=3, y=4, side=c(1,4)) %>%
2728
#' lines(x=c(3,4,3), y=c(2,4,6)) %>%
2829
#' lines(x=c(1,2,5), y=c(1,8,5)) %>%
2930
#' legend()
3031
#' defaultLegend
3132
#'
32-
#' above <- gsplot(list()) %>%
33-
#' points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>%
34-
#' points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>%
35-
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines 1", lty=5, col="orange") %>%
36-
#' lines(x=c(1,2,5), y=c(1,8,5), legend.name="Example Lines 2", lty=5, col="green") %>%
33+
#' above <- gsplot() %>%
34+
#' points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>%
35+
#' points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>%
36+
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5, col="orange") %>%
37+
#' lines(x=c(1,2,5), y=c(1,8,5), legend.name="Lines 2", lty=5, col="green") %>%
3738
#' legend(location="above")
3839
#' above
3940
#'
40-
#' below <- gsplot(list()) %>%
41-
#' points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>%
42-
#' points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>%
43-
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines 1", lty=5, col="orange") %>%
44-
#' lines(x=c(1,2,5), y=c(1,8,5), legend.name="Example Lines 2", lty=5, col="green") %>%
41+
#' below <- gsplot() %>%
42+
#' points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>%
43+
#' points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>%
44+
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5, col="orange") %>%
45+
#' lines(x=c(1,2,5), y=c(1,8,5), legend.name="Lines 2", lty=5, col="green") %>%
4546
#' legend(location="below")
4647
#' below
4748
#'
48-
#' toright <- gsplot(list()) %>%
49-
#' points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>%
50-
#' points(x=3, y=4, side=c(1,4), legend.name="Example Points 1", pch=1, col="blue") %>%
51-
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines 1", lty=5) %>%
52-
#' lines(x=c(1,2,5), y=c(1,8,5), legend.name="Example Lines 2", lty=5, col="green") %>%
49+
#' toright <- gsplot() %>%
50+
#' points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>%
51+
#' points(x=3, y=4, side=c(1,4), legend.name="Points 1", pch=1, col="blue") %>%
52+
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5) %>%
53+
#' lines(x=c(1,2,5), y=c(1,8,5), legend.name="Lines 2", lty=5, col="green") %>%
5354
#' legend(location="toright")
5455
#' toright
5556
#'
56-
#' toleft <- gsplot(list()) %>%
57-
#' points(x=1, y=2, side=c(3,2), legend.name="Example Points 1", pch=1, col="blue") %>%
58-
#' points(x=3, y=4, side=c(1,4), legend.name="Example Points 2", pch=5, col="red") %>%
59-
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Example Lines 1", lty=5, col="orange") %>%
57+
#' toleft <- gsplot() %>%
58+
#' points(x=1, y=2, side=c(3,2), legend.name="Points 1", pch=1, col="blue") %>%
59+
#' points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>%
60+
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5, col="orange") %>%
6061
#' lines(x=c(1,2,5), y=c(1,8,5), lty=5, col="green") %>%
6162
#' legend(location="below")
6263
#' toleft
64+
#'
65+
#' usrDef <- gsplot() %>%
66+
#' points(x=1, y=2, side=c(3,2), legend.name="Points 1", cex=3) %>%
67+
#' points(x=3, y=4, side=c(1,4), legend.name="Points 2", pch=5, col="red") %>%
68+
#' lines(x=c(3,4,3), y=c(2,4,6), legend.name="Lines 1", lty=5, col="orange") %>%
69+
#' lines(x=c(1,2,5), y=c(1,8,5), legend.name="Lines 2", lwd=3) %>%
70+
#' legend(x=3,y=4)
71+
#' usrDef
6372
legend <- function(object, ...){
6473
overrideGraphics("legend", object, ...)
6574
}
6675

6776

6877
legend.gsplot <- function(object, location="topright", legend_offset=0.3, ...) {
6978
arguments <- list(...)
79+
80+
if("x" %in% names(arguments)){
81+
location <- arguments$x
82+
}
83+
7084
gsConfig <- list(location = location, legend_offset = legend_offset)
7185

7286
arguments <- appendLegendPositionConfiguration(location, gsConfig, arguments)
@@ -88,6 +102,8 @@ appendLegendPositionConfiguration <- function(location, gsConfig, arguments) {
88102
return(append(arguments, list(x = "right", y = NULL, inset=c(-legend_offset, 0), bty="n")))
89103
} else if(location == "toleft") {
90104
return(append(arguments, list(x = "left", y = NULL, inset=c(-legend_offset, 0), bty="n")))
105+
} else if("x" %in% names(arguments)){
106+
return(arguments)
91107
} else {
92108
return(append(arguments, list(x = location)))
93109
}
@@ -137,7 +153,7 @@ draw_legend <- function(gsplot) {
137153
}
138154

139155
#get legend entries for lines
140-
lines_i <- which(names(gsplot) %in% 'lines')
156+
lines_i <- which(names(gsplot) %in% c('lines','abline'))
141157
for (i in lines_i){
142158
lines <- gsplot[[i]]
143159
if(all((c("lty","col") %in% names(lines[['arguments']])))){
@@ -152,6 +168,11 @@ draw_legend <- function(gsplot) {
152168

153169
smartLegend <- unique(smartLegend)
154170

171+
lineTypes <- c("blank", "solid", "dashed", "dotted", "dotdash", "longdash", "twodash")
172+
173+
lineNums <- suppressWarnings(as.numeric(smartLegend$line))
174+
smartLegend$line[!is.na(lineNums)] <- lineTypes[lineNums+1][!is.na(lineTypes[lineNums+1])]
175+
155176
if(nrow(smartLegend) > 0){
156177

157178
#only include pch if we have a non-NA entry for points

‎R/lines.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,13 +5,13 @@
55
#' @param \dots Further graphical parameters may also be supplied as arguments. See 'Details'.
66
#' @return modified gsplot object
77
#' @examples
8-
#' gsNew <- gsplot(list())
8+
#' gsNew <- gsplot()
99
#' gsNew <- lines(gsNew, c(1,2), y=c(2,5))
1010
#' gsNew <- lines(gsNew, c(3,4,3), c(2,4,6), pch=6)
1111
#' gsNew <- points(gsNew, c(8,4,1.2), c(2,4.7,6), side=c(3,2))
1212
#' gsNew
1313
#'
14-
#' gsNewpipe <- gsplot(list()) %>%
14+
#' gsNewpipe <- gsplot() %>%
1515
#' lines(c(1,2), c(2,5)) %>%
1616
#' lines(c(3,4,3), c(2,4,6), pch=6) %>%
1717
#' points(c(8,4,1.2), c(2,4.7,6), side=c(3,2))

‎R/points.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
#' @param \dots Further graphical parameters may also be supplied as arguments. See 'Details'.
99
#' @return modified gsplot object
1010
#' @examples
11-
#' gs <- gsplot(list())
11+
#' gs <- gsplot()
1212
#' gsNew <- points(gs, y=1, x=2, col="blue", pch=18)
1313
#' gsNew <- points(gsNew, c(3,4,3), c(2,4,6), ylim=c(0,10))
1414
#' gsNew

0 commit comments

Comments
 (0)