Let me start with a toy dataset
library(magrittr)
library(purrr)
set.seed(13)
X<-matrix(rnorm(120),20,6) %>% data.frame %>% set_colnames(LETTERS[1:5])
and a toy function that draws 6 scatterplots: one for each column of X against random vector.
foo<-function(X){
win.graph(5,5)
par(mfcol=c(3,2))
par(mar=c(5,4,.1,.1))
X %>% iwalk(~plot(.x, rnorm(20), xlab=.y, ylab='Random'))
}
foo(X)
Now I add dot-dot-dot mechanism to it:
foo<-function(X,...){
win.graph(5,5)
par(mfcol=c(3,2))
par(mar=c(5,4,.1,.1))
X %>% iwalk(~plot(.x, rnorm(20), xlab=.y, ylab='Random',...))
}
And now foo(X) results with an error Error in plot.window(...) : invalid 'xlim' value. Also foo(X, pch=2) gives the same error.
Why is that? Why iwalk seems to put any additional parameter passed via ... to xlim? How to change above code to be able to pass additional parameters via ...?
EDIT
I tried tidyeval approach with quos function and !!! operator:
foo<-function(X, ...){
win.graph(5,5)
par(mfcol=c(3,2))
par(mar=c(5,4,.1,.1))
vars<-quos(...)
X %>% iwalk(~plot(.x, rnorm(20),xlab=.y, ylab='Random', !!! vars))
}
Now both foo(X) and foo(X, pch=2) result with Error in plot.xy(xy, type, ...) : invalid plot type...
We could do this do.call
foo <- function(X, ...){
v1 <- c(...)
win.graph(5,5)
par(mfcol=c(3,2))
par(mar=c(5,4,.1,.1))
X %>%
iwalk(~ {args <- list(xlab = .y, ylab = 'Random')
args[names(v1)] <- v1
do.call(plot, c(list(x = .x, y = rnorm(20)), args))
})
}
foo(X)
foo(X, cex = 2)
foo(X, pch = 2)
foo(X, cex = 2, pch = 2)
foo(X, cex = 2, pch = 2, col = 2)
gives the output
Related
i have defined a method for printing a vector with the class test:
print.test <- function(x, ...) {
x <- formatC(
as.numeric(x),
format = "f",
big.mark = ".",
decimal.mark = ",",
digits = 1
)
x[x == "NA"] <- "-"
x[x == "NaN"] <- "-"
print.default(x)
}
which works fine for the following
a <- c(1000.11, 2000.22, 3000.33)
class(a) <- c("test", class(a))
print(a)
[1] "1.000,11" "2.000,22" "3.000,33"
this also works:
round(a)
[1] "1.000,0" "2.000,0" "3.000,0"
this does not:
median(a)
[1] 2000.22
class(median(a))
[1] "numeric"
now my question is: do i need to write a custom method for this class to use median e.g. and if so what would it look like or is there another way (as i simply would like this class to print the data in a certain format)?
The problem is that median.default returns an object of class numeric therefore autoprinting of the returned object does not call your custom print method.
The following will do so.
median.test <- function(x, na.rm = FALSE, ...){
y <- NextMethod(x, na.rm = na.rm, ...)
class(y) <- c("test", class(y))
y
}
median(a)
#[1] "2.000,2"
As for the handling of NA values, I will first define another method for a base R function. It is not strictly needed but save some code lines if objects of class test are used frequently.
c.test <- function(x, ...){
y <- NextMethod(x, ...)
class(y) <- c("test", class(y))
y
}
b <- c(a, NA)
class(b)
#[1] "test" "numeric"
median(b)
#[1] "-"
median(b, na.rm = TRUE)
#[1] "2.000,2"
EDIT.
The following defines a generic function wMedian, a default method and a method for objects of class "currency", as requested by the OP in a comment.
Note that there must be a method print.currency, which I don't redefine since it's exactly the same as print.test above. As for the other methods, I have made them simpler with the help of a new function, as.currency.
median.currency <- function(x, na.rm = FALSE, ...){
y <- NextMethod(x, na.rm = na.rm, ...)
as.currency(y)
}
c.currency <- function(x, ...){
y <- NextMethod(x, ...)
as.currency(y)
}
as.currency <- function(x){
class(x) <- c("currency", class(x))
x
}
wMedian <- function(x, ...) UseMethod("wMedian")
wMedian.default <- function(x, ...){
matrixStats::weightedMedian(x, ...)
}
wMedian.currency <- function(x, w = NULL, idxs = NULL, na.rm = FALSE, interpolate = is.null(ties), ties = NULL, ...) {
y <- NextMethod(x, w = w, idxs = idxs, na.rm = na.rm, interpolate = interpolate, ties = ties, ... )
as.currency(y)
}
set.seed(1)
x <- rnorm(10)
wMedian(x, w = (1:10)/10)
#[1] 0.4084684
wMedian(as.currency(x), w = (1:10)/10)
#[1] "0,4"
Tried this code via source()
f1 <- function(x, ...){
print(y)
}
f1(x = 1, y = 2)
or this code via source()
f1 <- function(x, ...){
y <- 2
f2(x, y = y, ...)
}
f2 <- function(x, ...){
print(y)
}
f1(x = 1)
Got this Error
Error in print(y) : object 'y' not found
I guess the '...' argument takes from the global environment?
you should call y in your function as correct like this
f1 <- function(x, ...){
l <- list(...)
if(!is.null(l$y)) print(l$y)
}
f1(x = 1, y=2)
How do I label the y-axis, using timeSeries::plot, with Greek letters? i.e. change SB, SP, etc. to \alpha, \beta etc., I'm am aware I need expression(), in some way. However I can't even get to the labels (I normally use ggplot2). Code below.
# install.packages("xtable", dependencies = TRUE)
library("timeSeries")
## Load Swiss Pension Fund Benchmark Data -
LPP <- LPP2005REC[1:12, 1:4]
colnames(LPP) <- abbreviate(colnames(LPP), 2)
finCenter(LPP) <- "GMT"
timeSeries::plot(LPP, type = "o")
It have been pointed out that the object structure, obtained with str(), is quite particular in LPP compared to say this object z
z <- ts(matrix(rnorm(300), 100, 3), start = c(1961, 1), frequency = 12)
plot(z)
If any one has an answer to both or any I would appreciate it. I realize I can convert the data and plot it with ggplot2, I have seen that here on SO, but I am interested in doing in directly on the timeSeries object LPP and the stats (time-series object) z
[ REVISION & Edited ]
When plot.type is "multiple", we can't define ylab directly. Both plot(ts.obj) (S3 method) and plot(timeSeries.obj) (S4 method) take colnames(obj) as ylab, and I don't know any methods of using Greek letters as colname. (The difference in structure mainly comes from the difference of S3 and S4; colnames(timeSeries.obj) is equivalent to timeSeries.obj#units; the defaults is Series i and TS.i).
We can step in ylab using the arugument, panel (It wants a function and the default is lines). It is used in for(i in 1:ncol(data)). I couldn't give panel.function a suitable "i" (I guess it can in some way, but I didn't think up), so I got "i" using which col the data matches.
for timeSeries
ylabs <- expression(alpha, beta, gamma, delta)
row1 <- LPP[1,]
timeSeries.panel.f <- function(x, y, ...) {
lines(x, y, ...)
mtext(ylabs[which(row1 %in% y[1])], 2, line = 3)
}
plot(LPP, panel = timeSeries.panel.f, type = "o", ann = F)
title("Title")
mtext("Time", 1, line = 3)
## If you aren't so concerned about warnings, here is more general.
## (Many functions read `...` and they return warnings).
timeSeries.panel.f2 <- function(x, y, ..., ylabs = ylabs, row1 = row1) {
lines(x, y, ...)
mtext(ylabs[which(row1 %in% y[1])], 2, line = 3)
}
plot(LPP, panel = timeSeries.panel.f2, type = "o", ann = F,
ylabs = expression(alpha, beta, gamma, delta), row1 = LPP[1,])
title("Title")
mtext("Time", 1, line = 3)
for ts
ylabs <- expression(alpha, beta, gamma)
row1 <- z[1,]
ts.panel.f <- function(y, ...) {
lines(y, ...)
mtext(ylabs[which(row1 %in% y[1])], 2, line = 3)
}
plot(z, panel = ts.panel.f, ann = F)
title("Title")
mtext("Time", 1, line = 3)
Of course you can archieve it using new functions made from the original (mostly the same as the original). I showed only the modified points.
modified plot(ts.obj) (made from plot.ts)
my.plot.ts <- function(~~~, my.ylab = NULL) {
:
nm <- my.ylab # before: nm <- colnames(x)
:
}
# use
my.plot.ts(z, my.ylab = expression(alpha, beta, gamma), type = "o")
modified plot(timeSeries.obj)
# made from `.plot.timeSeries`
my.plot.timeSeries <- function(~~~, my.ylab = NULL) {
:
my.plotTimeSeries(~~~, my.ylab = my.ylab)
}
# made from `timeSeries:::.plotTimeSeries`
my.plotTimeSeries <- function(~~~, my.ylab) {
:
nm <- my.ylab # before: nm <- colnames(x)
:
}
#use
my.plot.timeSeries(LPP, my.ylab = expression(alpha, beta, gamma, delta), type="o")
I am trying to write a custom curve function where the ... would be passed to the function rather than the plot: I would like to be able to use say:
curve2(dnorm, mean=2, sd=3)
I run into a problem with handling the ... in a call environment. Starting from a simplified prototype of curve:
minicurve <- function (expr, from = 0, to = 1, ...)
{
sexpr <- substitute(expr)
expr <- call(as.character(sexpr), as.name("x"))
ll <- list(x = seq(from=from, to=to, length.out=100))
names(ll) <- "x"
y <- eval(expr, envir = ll, enclos = parent.frame())
plot(x = ll$x, y = y, type="l")
}
# This gives the same behaviour as `curve`:
minicurve(dnorm)
Now I would like to pass the ... into the call (instead of passing into plot). Usually, this is very easy, one just need to pass the ... into the function. However, the call function behaves differently, and I am not sure how I should handle it. I can just use:
dot1 <- substitute(...)
expr <- call(as.character(sexpr), as.name(xname), dot1)
This will work, however it will pass only the first argument. I need hence to use someting like:
dots <- substitute(list(...))
expr <- call(as.character(sexpr), as.name(xname), dots)
But this doesn't work:
minicurve2 <- function (expr, from = 0, to = 1, ...)
{
sexpr <- substitute(expr)
dots <- substitute(list(...))
expr <- call(as.character(sexpr), as.name(xname), dots)
ll <- list(x = seq(from=from, to=to, length.out=100))
names(ll) <- "x"
y <- eval(expr, envir = ll, enclos = parent.frame())
plot(x = ll$x, y = y, type="l")
}
So how do I pass a list of ... into the call function? Thanks!
How about this
minicurve <- function (expr, from = 0, to = 1, ...) {
sexpr <- substitute(expr)
expr <- call(as.character(sexpr), as.name("x"))
ll <- list(x = seq(from=from, to=to, length.out=100))
names(ll) <- "x"
dots <- substitute(...())
expr <- as.call(c(as.list(expr), dots))
y <- eval(expr, envir = ll, enclos = parent.frame())
plot(x = ll$x, y = y, type="l")
}
Here we capture the ... as a list via the substitute(...()) syntax. Then we convert the call to a list, append in the parameters, and turn it back into a call.
We test with
minicurve(dnorm, mean=2, sd=3)
minicurve(dnorm, mean=.5, sd=5)
I need to intercept the value of an optional xlim in a function so that I can change the units of it before plotting. The following function confirms that xlim was passed, but I can't access the value.
foo <- function(x, y, ...) {
if ("xlim" %in% names(list(...))) {
print(xlim) # not found/can't use value!
}
# modify xlim and pass to plotting functions
return()
}
But foo(x = 1:5, y = 1:5, xlim = c(2,4)) gives:
Error in print(xlim) : object 'xlim' not found
What trick do I need use the value? Seems like it should just work, but I see from looking around on SO that the dots can be vexing. I've played a bit with exists, deparse etc but I don't really 'get' the proper use of those functions.
EDIT: so here is the final snippet which was the leanest way to access the value:
dots <- list(...)
if (any(names(dots) == "xlim")) {
xlim <- dots$xlim
print(xlim)
}
This is because xlim is actually a list element, and is not (yet) an actual object in the function's environment. You could do
foo <- function(x, y, ...) {
m <- match.call(expand.dots = FALSE)$...
if(any(names(m) == "xlim")) m[["xlim"]]
else stop("no xlim value")
}
foo(x = 1:5, y = 1:5, xlim = c(2,4))
# c(2, 4)
foo(x = 1:5, y = 1:5, ylim = c(2,4))
# Error in foo(x = 1:5, y = 1:5, ylim = c(2, 4)) : no xlim value
You can see what match.call is doing if we examine the function as
f <- function(x, y, ...) {
match.call(expand.dots = FALSE)$...
}
It is a list of all the entered dot arguments with their respective expressions, so there are many different ways to get the values, the above is just one way.
f(x = 1:5, y = 1:5, xlim = c(2,4))
# $xlim
# c(2, 4)
Alternatively, you could do
g <- function(x, y, ...) {
dots <- list(...)
any(names(dots) == "xlim")
}
g(x = 1:5, y = 1:5, xlim = c(2,4))
# [1] TRUE
Also keep in mind that match.call keeps the argument as an unevaluated call, while list(...) evaluates the argument. This might be important for you passing the argument to other functions.