Skip to content

Commit 3ca45ac

Browse files
author
Jordan S Read
committed
reusing set_window_args()
1 parent 5e48854 commit 3ca45ac

File tree

12 files changed

+47
-114
lines changed

12 files changed

+47
-114
lines changed

‎R/abline.R‎

Lines changed: 1 addition & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -28,14 +28,5 @@ abline <- function(object, ...) {
2828

2929

3030
abline.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
31-
current_list <- config("abline")
32-
arguments <- list(...)
33-
34-
indicesToAdd <- !(names(current_list) %in% names(arguments))
35-
arguments <- append(arguments, current_list[indicesToAdd])
36-
37-
object <- append(object, list(abline = list(arguments = arguments,
38-
gs.config=list(legend.name = legend.name,
39-
side = side))))
40-
return(gsplot(object))
31+
set_window_args(object, fun.name='abline', ..., legend.name=legend.name, side=side)
4132
}

‎R/arrows.R‎

Lines changed: 2 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -32,17 +32,6 @@ arrows <- function(object, ...) {
3232
}
3333

3434

35-
arrows.gsplot <- function(object, x0, y0, x1 = x0, y1 = y0, length = 0.25, angle = 30,
36-
..., code = 2, legend.name=NULL, side=c(1,2)){
37-
current_list <- config("arrows")
38-
arguments <- append(list(x0=x0, y0=y0, x1 = x1, y1 = y1, length = length, angle = angle,
39-
code = code), c(...))
40-
41-
indicesToAdd <- !(names(current_list) %in% names(arguments))
42-
arguments <- append(arguments, current_list[indicesToAdd])
43-
44-
object <- append(object, list(arrows = list(arguments = arguments,
45-
gs.config=list(legend.name = legend.name,
46-
side = side))))
47-
return(gsplot(object))
35+
arrows.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
36+
set_window_args(object, fun.name='arrows', ..., legend.name=legend.name, side=side)
4837
}

‎R/bgCol.R‎

Lines changed: 2 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -25,17 +25,8 @@ bgCol <- function(object, ...) {
2525
}
2626

2727

28-
bgCol.gsplot <- function(object, col, ..., legend.name=NULL, side=c(1,2)){
29-
current_list <- config("bgCol")
30-
arguments <- list(...)
31-
arguments <- append(list(col=col),arguments)
32-
indicesToAdd <- !(names(current_list) %in% names(arguments))
33-
arguments <- append(arguments, current_list[indicesToAdd])
34-
35-
object <- append(object, list(bgCol = list(arguments = arguments,
36-
gs.config=list(legend.name = legend.name,
37-
side = side))))
38-
return(gsplot(object))
28+
bgCol.gsplot <- function(object, ..., side=c(1,2)){
29+
set_window_args(object, fun.name="bgCol", ..., legend.name=NULL, side=side, package='gsplot')
3930
}
4031

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

‎R/callouts.R‎

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -29,11 +29,7 @@ callouts <- function(object, ...) {
2929

3030
callouts.gsplot <- function(object, ..., side=c(1,2)){
3131

32-
fun.name <- "callouts"
33-
to.gsplot <- list(list(arguments = set_args(fun.name, package='gsplot', ...),
34-
gs.config=list(side = side))) %>%
35-
setNames(fun.name)
36-
return(gsplot(append(object, to.gsplot)))
32+
set_window_args(object, fun.name='callouts', ..., legend.name=NULL, side=side, package='gsplot')
3733
}
3834
#' Default for adding callouts to a plot.
3935
#'

‎R/embedded-functions.R‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@ separate_args <- function(...){
1111
dots <- lazy_dots(...)
1212
args = list(args=dots)
1313

14+
if(length(args[[1]]) == 0)
15+
return()
1416
embeds <- unname(sapply(dots, function(x) is_in_package(x$expr)))
1517

1618
if (sum(embeds) == 0)

‎R/error_bars.R‎

Lines changed: 6 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -35,17 +35,9 @@ error_bar <- function(object, ...) {
3535
}
3636

3737

38-
error_bar.gsplot <- function(object, x, y, ..., y.high=0, y.low=0, x.high=0, x.low=0,
39-
epsilon=0.1, legend.name=NULL, side=c(1,2)){
38+
error_bar.gsplot <- function(object, x, y, y.high=0, y.low=0, x.high=0, x.low=0,
39+
epsilon=0.1, ..., legend.name=NULL, side=c(1,2)){
4040

41-
args <- c(...)
42-
if (length(args) != 0) {
43-
for (i in 1:length(args)) {
44-
assign(names(args)[i], value=args[[i]])
45-
}
46-
args <- args[!names(args) %in% c("y.high", "y.low", "x.high", "x.low")]
47-
}
48-
4941
y.high[is.na(y.high)] <- 0
5042
y.low[is.na(y.low)] <- 0
5143
x.high[is.na(x.high)] <- 0
@@ -57,7 +49,7 @@ error_bar.gsplot <- function(object, x, y, ..., y.high=0, y.low=0, x.high=0, x.l
5749
y.low.coord <- y.low.coord[errorIndex]
5850
y.error <- y[errorIndex]
5951
x.error <- x[errorIndex]
60-
object <- arrows(object, x0=x.error, y0=y.error, x1=x.error, y1=y.low.coord, length=epsilon, angle=90, args)
52+
object <- arrows(object, x0=x.error, y0=y.error, x1=x.error, y1=y.low.coord, length=epsilon, angle=90, ...)
6153
}
6254

6355
if(!all(y.high == 0)){
@@ -66,7 +58,7 @@ error_bar.gsplot <- function(object, x, y, ..., y.high=0, y.low=0, x.high=0, x.l
6658
y.high.coord <- y.high.coord[errorIndex]
6759
y.error <- y[errorIndex]
6860
x.error <- x[errorIndex]
69-
object <- arrows(object, x0=x.error, y0=y.error, x1=x.error, y1=y.high.coord, length=epsilon, angle=90, args)
61+
object <- arrows(object, x0=x.error, y0=y.error, x1=x.error, y1=y.high.coord, length=epsilon, angle=90, ...)
7062
}
7163

7264
if(!all(x.low == 0)){
@@ -75,7 +67,7 @@ error_bar.gsplot <- function(object, x, y, ..., y.high=0, y.low=0, x.high=0, x.l
7567
x.low.coord <- x.low.coord[errorIndex]
7668
x.error <- x[errorIndex]
7769
y.error <- y[errorIndex]
78-
object <- arrows(object, x0=x.error, y0=y.error, x1=x.low.coord, y1=y.error, length=epsilon, angle=90, args)
70+
object <- arrows(object, x0=x.error, y0=y.error, x1=x.low.coord, y1=y.error, length=epsilon, angle=90, ...)
7971
}
8072

8173
if(!all(x.high == 0)){
@@ -84,7 +76,7 @@ error_bar.gsplot <- function(object, x, y, ..., y.high=0, y.low=0, x.high=0, x.l
8476
x.high.coord <- x.high.coord[errorIndex]
8577
x.error <- x[errorIndex]
8678
y.error <- y[errorIndex]
87-
object <- arrows(object, x0=x.error, y0=y.error, x1=x.high.coord, y1=y.error, length=epsilon, angle=90, args)
79+
object <- arrows(object, x0=x.error, y0=y.error, x1=x.high.coord, y1=y.error, length=epsilon, angle=90, ...)
8880
}
8981

9082
return(object)

‎R/grid.R‎

Lines changed: 1 addition & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -21,11 +21,5 @@ grid <- function(object, ...) {
2121

2222

2323
grid.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
24-
fun.name <- "grid"
25-
arguments <- list(...)
26-
27-
to.gsplot <- list(list(arguments = do.call(set_args, c(fun.name, arguments)),
28-
gs.config=list(legend.name = legend.name, side = side))) %>%
29-
setNames(fun.name)
30-
return(gsplot(append(object, to.gsplot)))
24+
set_window_args(object, fun.name='grid', ..., legend.name=legend.name, side=side)
3125
}

‎R/lines.R‎

Lines changed: 1 addition & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -43,21 +43,5 @@ lines <- function(object, ...) {
4343

4444

4545
lines.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
46-
fun.name <- "lines"
47-
dots = separate_args(...)
48-
args = dots$args
49-
e.fun = dots$e.fun
50-
arguments = set_args(fun.name, lazy_eval(args))
51-
to.gsplot <- list(list(arguments = arguments, gs.config=list(legend.name = legend.name, side = side))) %>%
52-
setNames(fun.name)
53-
54-
object <- gsplot(append(object, to.gsplot)) # append initial call
55-
if (!is.null(e.fun)){
56-
for (i in seq_len(length(e.fun))){
57-
fun.name = names(e.fun)[i]
58-
embed.args = set_inherited_args(fun.name, arguments, e.fun[[i]])
59-
object <- do.call(fun.name, append(list(object=object), embed.args))
60-
}
61-
}
62-
return(object)
46+
set_window_args(object, fun.name='lines', ..., legend.name=legend.name, side=side)
6347
}

‎R/mtext.R‎

Lines changed: 1 addition & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -29,24 +29,5 @@ mtext <- function(object, ...) {
2929

3030

3131
mtext.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
32-
current_list <- config("mtext")
33-
arguments <- list(...)
34-
35-
indicesToAdd <- !(names(current_list) %in% names(arguments))
36-
arguments <- append(arguments, current_list[indicesToAdd])
37-
38-
39-
if(length(side) == 1){
40-
arguments <- append(arguments, list(side=side))
41-
if (side %% 2 == 0){
42-
side <- c(1, side)
43-
} else {
44-
side <- c(side, 2)
45-
}
46-
}
47-
48-
object <- append(object, list(mtext = list(arguments = arguments,
49-
gs.config=list(legend.name = legend.name,
50-
side = side))))
51-
return(gsplot(object))
32+
set_window_args(object, fun.name='mtext', ..., legend.name=legend.name, side=side)
5233
}

‎R/points.R‎

Lines changed: 1 addition & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -46,21 +46,5 @@ points <- function(object, ...) {
4646
}
4747

4848
points.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
49-
fun.name <- "points"
50-
dots = separate_args(...)
51-
args = dots$args
52-
e.fun = dots$e.fun
53-
arguments = set_args(fun.name, lazy_eval(args))
54-
to.gsplot <- list(list(arguments = arguments, gs.config=list(legend.name = legend.name, side = side))) %>%
55-
setNames(fun.name)
56-
57-
object <- gsplot(append(object, to.gsplot)) # append initial call
58-
if (!is.null(e.fun)){
59-
for (i in seq_len(length(e.fun))){
60-
fun.name = names(e.fun)[i]
61-
embed.args = set_inherited_args(fun.name, arguments, e.fun[[i]])
62-
object <- do.call(fun.name, append(list(object=object), embed.args))
63-
}
64-
}
65-
return(object)
49+
set_window_args(object, fun.name='points', ..., legend.name=legend.name, side=side)
6650
}

0 commit comments

Comments
 (0)