Skip to content

Commit 75f4e72

Browse files
ldecicco-USGSldecicco-USGS
committed
Merge pull request #271 from ldecicco-USGS/master
grid, bgCol, title
2 parents f911146 + c0910ed commit 75f4e72

29 files changed

+366
-105
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: gsplot
22
Type: Package
33
Title: Geological Survey Plotting
4-
Version: 0.4.1
4+
Version: 0.4.2
55
Date: 2015-09-16
66
Authors@R: c( person("Jordan", "Read", role = "aut",
77
email = "[email protected]"),

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
S3method(gsplot,default)
44
S3method(logged,gsplot)
55
S3method(print,gsplot)
6+
S3method(summary,gsplot)
67
S3method(xlim,gsplot)
78
S3method(ylim,gsplot)
89
export("%>%")

‎R/access-gsplot.R‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -95,5 +95,12 @@ view_info <- function(object){
9595

9696
viewInfo[,c("x","y","index")] <- sapply(viewInfo[,c("x","y","index")], function(x) as.integer(x))
9797

98+
i <- which(names(object) %in% 'axis')
99+
definded.sides <- sapply(i, function(x) object[[x]][['arguments']][['side']])
100+
view.sides.drawn <- NULL
101+
102+
viewInfo$x.side.defined.by.user <- viewInfo$x %in% definded.sides
103+
viewInfo$y.side.defined.by.user <- viewInfo$y %in% definded.sides
104+
98105
return(viewInfo)
99106
}

‎R/axis.R‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -17,12 +17,13 @@
1717
#' gs <- gsplot() %>%
1818
#' points(x=1:5, y=1:5, legend.name="Stuff") %>%
1919
#' lines(2:6, y=2:6, ylim=c(0,10)) %>%
20+
#' bgCol(col="lightgoldenrod") %>%
2021
#' axis(side=c(3,4),labels=FALSE) %>%
2122
#' legend("topright")
2223
#' gs
2324
#'
2425
#' gs <- gsplot() %>%
25-
#' points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA)) %>%
26+
#' points(y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA),las=0) %>%
2627
#' axis(side=c(4), labels=FALSE) %>%
2728
#' axis(side=c(1,3), n.minor=4)
2829
#' gs
@@ -34,8 +35,8 @@
3435
#' gs
3536
#'
3637
#' gs <- gsplot() %>%
37-
#' points(1:5, c(1,10,100,1000,10000), log="y", las=1) %>%
38-
#' axis(side=c(2,4), n.minor=4)
38+
#' points(1:5, c(1,10,100,1000,10000), log="y") %>%
39+
#' axis(side=c(2,4), n.minor=4, las=1)
3940
#' gs
4041
#'
4142
#' gs <- gsplot() %>%

‎R/bgCol.R‎

Lines changed: 22 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -10,23 +10,38 @@
1010
#' @examples
1111
#' gs <- gsplot() %>%
1212
#' points(y=c(3,1,2), x=4:6, xlim=c(0,NA),legend.name="Points") %>%
13+
#' bgCol(col="lightgrey") %>%
1314
#' lines( c(3,4,3), c(2,4,6), legend.name="Lines", side=c(3,4)) %>%
14-
#' legend(location="topleft") %>%
15-
#' bgCol(col="lightgrey")
16-
#'
15+
#' legend(location="topleft")
1716
#' gs
1817
#'
19-
#' gsPlain <- gsplot()%>%
18+
#' gs <- gsplot() %>%
2019
#' points(1:100, rnorm(100,mean=10000, sd=1000), log="y") %>%
2120
#' bgCol(col="lightgrey")
22-
#' gsPlain
21+
#' gs
22+
#'
23+
#' gs <- gsplot() %>%
24+
#' points(1:100, rnorm(100,mean=10000, sd=1000), log="y") %>%
25+
#' bgCol() #yaml specifies lightgrey
26+
#' gs
27+
#'
28+
#' gs <- gsplot() %>%
29+
#' points(1:100, rnorm(100,mean=10000, sd=1000), log="y") %>%
30+
#' bgCol("lightgoldenrod")
31+
#' gs
2332
bgCol <- function(object, ...) {
2433
override("gsplot", "bgCol", object, ...)
2534
}
2635

2736

28-
bgCol.gsplot <- function(object, ..., side=c(1,2)){
29-
set_window_args(object, fun.name="bgCol", ..., legend.name=NULL, side=side, package='gsplot')
37+
bgCol.gsplot <- function(object, ...){
38+
39+
to.gsplot <- set_args("bgCol",..., package = "gsplot")
40+
41+
to.gsplot <- list("bgCol"=to.gsplot)
42+
43+
object <- append(object, to.gsplot)
44+
return(gsplot(object))
3045
}
3146

3247
bgCol.default <- function(col,...){

‎R/calc_views.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -186,6 +186,7 @@ c_unname <- function(list){
186186
unname_c <- function(list){
187187
do.call(c, unname(list))
188188
}
189+
189190
views_with_side <- function(views, side){
190191
if(length(side) > 1)
191192
stop('side can only be length of 1')

‎R/grid.R‎

Lines changed: 77 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,11 +15,86 @@
1515
#' gsNew <- abline(gsNew, b=1, a=0, legend.name="1:1")
1616
#' gsNew <- legend(gsNew, location="topleft",title="Awesome!")
1717
#' gsNew
18+
#'
19+
#' gs <- gsplot() %>%
20+
#' points(1:10,1:10) %>%
21+
#' lines(6:14,6:14,side=c(3,4)) %>%
22+
#' grid(side=c(3,4))
23+
#' gs
24+
#'
25+
#' gs <- gsplot() %>%
26+
#' points(1:10,1:10) %>%
27+
#' axis(side=1, at=seq(1,10,length.out=18),las=3) %>%
28+
#' axis(side=3, labels=FALSE) %>%
29+
#' grid(side=c(1,2),col="green") %>%
30+
#' grid(side=c(3,4))
31+
#' gs
32+
#'
33+
#' gs <- gsplot() %>%
34+
#' points(x=seq.Date(as.Date("2000-01-01"),as.Date("2010-01-01"),length.out = 20),
35+
#' y=1:20,axes=FALSE) %>%
36+
#' grid()
37+
#' gs
38+
#'
39+
#' gs <- gsplot() %>%
40+
#' points(x=1:10, y=1:10) %>%
41+
#' grid(lty=3, col="gray") %>%
42+
#' axis(side=2, reverse=TRUE)
43+
#' gs
1844
grid <- function(object, ...) {
1945
override("graphics", "grid", object, ...)
2046
}
2147

22-
2348
grid.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
24-
set_window_args(object, fun.name='grid', ..., legend.name=legend.name, side=side, def.funs = graphics::grid)
49+
50+
object <- set_window_args(object, fun.name='grid', ..., legend.name=legend.name, side=side, def.funs = graphics::grid)
51+
52+
}
53+
54+
draw_custom_grid <- function(object, index){
55+
56+
i <- which(names(object) %in% 'axis')
57+
definded.sides <- sapply(i, function(x) object[[x]][['arguments']][['side']])
58+
59+
window = object[[index]][['window']]
60+
61+
view.info <- view_info(object)
62+
view.info <- view.info[index == view.info$index,]
63+
64+
grid.args <- set_args("grid",object[[index]][['grid']], package = "graphics")
65+
66+
if(class(window$xlim) %in% c("numeric","integer")){
67+
x.at <- axTicks(view.info$x)
68+
} else if (class(window$xlim) == "Date"){
69+
x.at <- axis.Date(view.info$x,window$xlim)
70+
} else if (class(window$xlim) == "POSIXct"){
71+
x.at <- axis.POSIXct(view.info$x,window$xlim)
72+
}
73+
74+
if(view.info$x.side.defined.by.user){
75+
axes.index <- i[definded.sides == view.info$x]
76+
x <- object[axes.index][['axis']][['arguments']][['at']]
77+
if(!is.null(x)){
78+
x.at <-x
79+
}
80+
}
81+
82+
if(class(window$ylim) %in% c("numeric","integer")){
83+
y.at <- axTicks(view.info$y)
84+
} else if (class(window$ylim) == "Date"){
85+
y.at <- axis.Date(view.info$y,window$ylim)
86+
} else if (class(window$ylim) == "POSIXct"){
87+
y.at <- axis.POSIXct(view.info$y,window$ylim)
88+
}
89+
90+
if(view.info$y.side.defined.by.user){
91+
axes.index <- i[definded.sides == view.info$y]
92+
y <- object[axes.index][['axis']][['arguments']][['at']]
93+
if(!is.null(y)){
94+
y.at <- y
95+
}
96+
}
97+
grid.args <- grid.args[names(grid.args) != "equilogs"]
98+
abline(h=y.at, v=x.at, grid.args)
99+
25100
}

‎R/gsplot-class.R‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,3 +26,35 @@ gsplot.list <- function(x){
2626
class(x) <- "gsplot"
2727
invisible(x)
2828
}
29+
30+
#' Summary of gsplot object
31+
#'
32+
#' Summary information
33+
#'
34+
#' @param object list
35+
#' @param \dots additional parameters
36+
#' @export
37+
#' @examples
38+
#' gs <- gsplot() %>%
39+
#' points(1:10,1:10) %>%
40+
#' axis(side=1, at=seq(1,10,length.out=18),las=3) %>%
41+
#' axis(side=3, labels=FALSE) %>%
42+
#' grid(side=c(1,2),col="green") %>%
43+
#' grid(side=c(3,4))
44+
#' summary(gs)
45+
summary.gsplot <- function(object,...){
46+
47+
view.info <- view_info(object)
48+
cat("Summary information of plotting object:\n")
49+
cat(nrow(view.info),"views:\n")
50+
for(i in seq_len(nrow(view.info))){
51+
cat("View:",i,"\nx side:", view.info$x[i], ",y side:", view.info$y[i], "\n")
52+
cat("xlim:",as.numeric(xlim(object, side=view.info$x[i])[[1]]),",")
53+
cat("ylim:",as.numeric(ylim(object, side=view.info$y[i])[[1]]))
54+
if(view.info$log[i] != ""){
55+
cat(",log:",view.info$log[i])
56+
}
57+
cat("\n")
58+
}
59+
}
60+

‎R/print.R‎

Lines changed: 28 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -43,10 +43,13 @@ print.gsplot <- function(x, ...){
4343
i <- which(names(views) %in% 'axis')
4444
definded.sides <- sapply(i, function(x) views[[x]][['arguments']][['side']])
4545

46+
bg.arg <- views$bgCol
47+
title.arg <- views$title
48+
4649
view.info <- view_info(views)
47-
view.sides.drawn <- NULL
50+
view.index <- view.info$index
4851

49-
for (i in which(names(views) %in% 'view')){
52+
for (i in view.index){
5053

5154
plots = views[[i]]
5255
plots[['window']] <- NULL
@@ -57,31 +60,38 @@ print.gsplot <- function(x, ...){
5760
par(window[['par']])
5861
plot.window(xlim = window$xlim, ylim = window$ylim, log = view.info$log[i==view.info$index])
5962

60-
sides.not.defined <- window$side[!(window$side %in% definded.sides)]
61-
62-
if(!is.null(view.sides.drawn)){
63-
view.sides.drawn <- sides.not.defined[-view.sides.drawn]
63+
# -- initial view --
64+
if(i == view.index[1]){
65+
bgCol(bg.arg)
66+
title(title.arg)
6467
}
6568

69+
# -- call functions --
70+
71+
if((sum(view.info$x.side.defined.by.user[i], view.info$y.side.defined.by.user[i])== 0 ) &
72+
(class(window$xlim) == "numeric" & class(window$ylim) == "numeric") |
73+
!(any(names(plots) %in% 'grid'))){
74+
to_gsplot(lapply(plots, function(x) x[!names(x) %in% 'legend.name']))
75+
} else {
76+
draw_custom_grid(views,i)
77+
plots <- plots[!(names(plots) %in% 'grid')]
78+
to_gsplot(lapply(plots, function(x) x[!(names(x) %in% c('legend.name'))]))
79+
}
80+
6681
if(window$axes){
67-
for(j in sides.not.defined){
68-
if(j %% 2 != 0){
69-
Axis(side=j,x=window$xlim)
70-
} else {
71-
Axis(side=j,x=window$ylim)
72-
}
73-
view.sides.drawn <- append(view.sides.drawn, j)
82+
if(!view.info$x.side.defined.by.user[i]){
83+
Axis(side=view.info$x[i],x=window$xlim)
84+
}
85+
if(!view.info$y.side.defined.by.user[i]){
86+
Axis(side=view.info$y[i],x=window$ylim)
7487
}
7588
}
7689

7790
if(window$ann){
78-
mtext(text=window$xlab, side=window$side[1], line = 2)
79-
mtext(text=window$ylab, side=window$side[2], line = 2)
91+
mtext(text=window$xlab, side=window$side[1], line = 2, las=config("mtext")$las)
92+
mtext(text=window$ylab, side=window$side[2], line = 2, las=config("mtext")$las)
8093
}
8194

82-
# -- call functions --
83-
to_gsplot(lapply(plots, function(x) x[!names(x) %in% 'legend.name']))
84-
8595
par(new=TRUE)
8696
}
8797

‎R/title.R‎

Lines changed: 18 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -16,18 +16,28 @@
1616
#'
1717
#' @export
1818
#' @examples
19-
#' gs <- gsplot()
20-
#' gsNew <- points(gs, y=1, x=2, col="blue", pch=18, legend.name="Points", xlab="Stuff")
21-
#' gsNew <- lines(gsNew, c(3,4,3), c(2,4,6), legend.name="Lines", ylab="Data!")
22-
#' gsNew <- abline(gsNew, b=1, a=0, legend.name="1:1")
23-
#' gsNew <- legend(gsNew, location="topleft",title="Awesome!")
24-
#' gsNew <- title(gsNew, main="Great Graph", col.main="grey", font.main=2, cex.main=2)
25-
#' gsNew
19+
#' gs <- gsplot() %>%
20+
#' points(y=1, x=2, col="blue", pch=18, legend.name="Points", xlab="Stuff") %>%
21+
#' lines(c(3,4,3), c(2,4,6), legend.name="Lines", ylab="Data!") %>%
22+
#' abline(b=1, a=0, legend.name="1:1") %>%
23+
#' legend(location="topleft",title="Awesome!") %>%
24+
#' title(main="Great Graph", col.main="grey", font.main=2, cex.main=2)
25+
#' gs
26+
#' gs <- gsplot() %>%
27+
#' points(y=1, x=2) %>%
28+
#' title(main="Great Graph")
29+
#' gs
2630
title <- function(object, ...) {
2731
override("graphics", "title", object, ...)
2832
}
2933

3034

3135
title.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
32-
set_window_args(object, fun.name='title', ..., legend.name=legend.name, side=side, def.funs=graphics::title)
36+
to.gsplot <- set_args("title",..., package = "graphics")
37+
38+
to.gsplot <- list("title"=to.gsplot)
39+
40+
object <- append(object, to.gsplot)
41+
return(gsplot(object))
42+
# set_window_args(object, fun.name='title', ..., legend.name=legend.name, side=side, def.funs=graphics::title)
3343
}

0 commit comments

Comments
 (0)