Contrast the following two code snippets:
1)
> y <- 1
> g <- function(x) {
+ y <- 2
+ UseMethod("g")
+ }
> g.numeric <- function(x) y
> g(10)
[1] 2
2)
> x <- 1
> g <- function(x) {
+ x <- 2
+ UseMethod("g")
+ }
> g.numeric <- function(y) x
> g(10)
[1] 1
In the first snippet, g.numeric's free variable (namely, "y") is evaluated in g's local environment, whereas in the second snippet, g.numeric's free variable (namely "x") is evaluated in the global environment. How so?
As it says in Writing R Extensions:
A method must have all the arguments of the generic, including … if the generic does.
Your second example does not (g(x) vs g.numeric(y)). If you redefine g <- function(y), everything works the same as your first example.
> x <- 1
> g <- function(y) {
+ x <- 2
+ UseMethod("g")
+ }
> g.numeric <- function(y) x
> g(10)
[1] 2
Related
I fear I get something really wrong. The basics are from here
and a basic (minimal) example is understood (I think) and working:
fun.default <- function(x) { # you could add further fun.class1 (works)...
print("default")
return(x[1] + x[2])
}
my_fun <- function(x) {
print("my_fun")
print(x)
res <- UseMethod("fun", x)
print(res)
print("END my_fun...")
return(res)
}
x <- c(1, 2)
my_fun(x)
However, if I want to add parameters, something goes really wrong. Form the link above:
Once UseMethod has found the correct method, it’s invoked in a special
way. Rather than creating a new evaluation environment, it uses the
environment of the current function call (the call to the generic), so
any assignments or evaluations that were made before the call to
UseMethod will be accessible to the method.
I tried all variants I could think of:
my_fun_wrong1 <- function(x, y) {
print("my_fun_wrong1")
print(x)
x <- x + y
print(x)
res <- UseMethod("fun", x)
print(res)
print("END my_fun_wrong1...")
return(res)
}
x <- c(1, 2)
# Throws: Error in fun.default(x, y = 2) : unused argument (y = 2)
my_fun_wrong1(x, y = 2)
my_fun_wrong2 <- function(x) {
print("my_fun_wrong2")
print(x)
x <- x + y
print(x)
res <- UseMethod("fun", x)
print(res)
print("END my_fun_wrong2...")
return(res)
}
x <- c(1, 2)
y = 2
# Does not throw an error, but does not give my expetced result "7":
my_fun_wrong2(x) # wrong result!?
rm(y)
my_fun_wrong3 <- function(x, ...) {
print("my_fun_wrong3")
print(x)
x <- x + y
print(x)
res <- UseMethod("fun", x)
print(res)
print("END my_fun_wrong3...")
return(res)
}
x <- c(1, 2)
# Throws: Error in my_fun_wrong3(x, y = 2) : object 'y' not found
my_fun_wrong3(x, y = 2)
Edit after answer G. Grothendieck: Using fun.default <- function(x, ...) I get
Runs after change, but I don't understand the result:
my_fun_wrong1(x, y = 2)
[1] "my_fun_wrong1"
[1] 1 2
[1] 3 4 # Ok
[1] "default"
[1] 3 # I excpect 7
As before - I don't understand the result:
my_fun_wrong2(x) # wrong result!?
[1] "my_fun_wrong2"
[1] 1 2
[1] 3 4 # Ok!
[1] "default"
[1] 3 # 3 + 4 = 7?
Still throws an error:
my_fun_wrong3(x, y = 2)
[1] "my_fun_wrong3"
[1] 1 2
Error in my_fun_wrong3(x, y = 2) : object 'y' not found
I think, this question is really useful!
fun.default needs ... so that the extra argument is matched.
fun.default <- function(x, ...) {
print("default")
return(x[1] + x[2])
}
x <- c(1, 2)
my_fun_wrong1(x, y = 2)
## [1] "my_fun_wrong1"
## [1] 1 2
## [1] 5 6
## [1] 3
Also, any statements after the call to UseMethod in the generic will not be evaluated as UseMethoddoes not return so it is pointless to put code after it in the generic.
Furthermore, you can't redefine the arguments to UseMethod. The arguments are passed on as they came in.
Suggest going over the help file ?UseMethod although admittedly it can be difficult to read.
Regarding the quote from ?UseMethod that was added to the question, this just means that the methods can access local variables defined in the function calling UseMethod. It does not mean that you can redefine arguments. Below ff.default refers to the a defined in ff.
a <- 0
ff <- function(x, ...) { a <- 1; UseMethod("ff") }
ff.default <- function(x, ...) a
ff(3)
## [1] 1
I am trying to create an object of class "weeknumber", which would have the following format: "2019-W05"
Additionally, I need to be able to use this object with +- operators. Similarly like "Date" variables behave in base R. For instance:
"2019-W05" + 1 = "2019-W06"
"2019-W01" - 1 = "2018-W52"
"2019-W03" - "2019-W01" = 2
I managed to partially achieve my goal. This is what I got so far:
weeknum <- function(date){
# Function that creates weeknumber object from a date
weeknumber <- paste(isoyear(date), formatC(isoweek(date), width = 2, format = "d", flag = "0"), sep = "-W")
class(weeknumber) <- c("weeknumber", class(weeknumber))
weeknumber
}
week2date <- function(weeknumber, weekday = 4) {
# Wrapper around ISOweek2date function from the 'ISOweek' package
ISOweek2date(paste(weeknumber, weekday, sep = "-"))
}
"+.weeknumber" <- function(x, ...) {
# Creating a method for addition
x <- week2date(x) + sum(...)*7
weeknum(x)
}
"-.weeknumber" <- function(x, ...) {
# Creating a method for subtraction
x <- week2date(x) - sum(...)*7
weeknum(x)
}
What works:
> x <- weeknum("2019-01-01")
> x
[1] "2019-W01"
attr(,"class")
[1] "weeknumber" "character"
> x + 1
[1] "2019-W02"
attr(,"class")
[1] "weeknumber" "character"
> x - 1
[1] "2018-W52"
attr(,"class")
[1] "weeknumber" "character"
Works as expected! The only annoying thing is that calling the variable also
prints out the attributes. Any way to hide them in the default print out?
What doesn't work:
> 1 + x
Error: all(is.na(weekdate) | stringr::str_detect(weekdate, kPattern)) is not TRUE
> y <- weeknum("2019-03-01")
> y - x
Error in as.POSIXlt.default(x) :
do not know how to convert 'x' to class “POSIXlt”
Any help appreciated!
Edit:
Figured out a solution how to make 1 + x (where x is a weeknumber) work. Not very elegant but does the job.
"+.weeknumber" <- function(...) {
# Creating a method for addition
vector <- c(...)
week_index <- which(unlist(lapply(list(...), function(x) class(x)[1]))=="weeknumber")
week <- vector[week_index]
other_values <- sum(as.numeric(c(...)[-week_index]))
x <- week2date(week) + other_values*7
weeknum(x)
}
> x <- weeknum("2019-01-01")
> x
[1] "2019-W01"
> 5 + x + 1 + 2 - 1
[1] "2019-W08"
For the first part: Define a custom print-method for your class:
print.weeknumber <- function(x,...)
{
attributes(x) <- NULL
print(x)
}
How can I update a function using the value of an assigned variable? This would be useful for updating functions in a for loop.
t <- 10
fn <- function(x) return(x + t)
Call
function(x) return(x + t)
Desired output
function(x) return(x + 10)
Attempt
I tried using body() and expression() but with no luck.
body(fn) <- expression(x + t)
Update: I should mention I need the function to update so I can integrate it using the integrate() function.
I'd recommend making a closure instead, that is a function that returns a function (with an associated environment, where t is found in this case):
fn <- function(t) function(x) x + t
fn(10)
# function(x) x + t
# <bytecode: 0x02aa2a74>
# <environment: 0x177baf80>
fn(10)(32)
# [1] 42
Example use in a for loop:
for (i in 1:3) print(fn(i)(7))
# [1] 8
# [1] 9
# [1] 10
Thanks to #Rich Scriven, this works:
body(fn)[[2]] <- substitute(x + t, list(t = t))
Call
> fn
> function (x)
> return(x + 10)
> fn(1)
> 11
I would like to hide printed output when saving output of my own function.
f2 <- function(x) {
cat("x + 5 = ", x + 5)
invisible(x + 5)
}
f2(1) # prints
a <- f2(1) # also prints
In other words I would like to make my function print
x + 5 = 6
when calling f2(1) but in case of calling a <- f2(1) I dont want to show any printed output. Is there any easy way how to do that?
You can use a class system for this. Here's a simple S3 example:
f2 <- function(x) {
names(x) <- paste(x, "+ 5")
class(x) <- c(class(x), 'foo')
x + 5
}
print.foo <- function(x) { cat(names(x), "=", x)}
In practice:
> x <- 3
> f2(x)
3 + 5 = 8
> y <- f2(x)
>
Note that the print.foo function does not handle vectors of length > 1 gracefully. That could be fixed, if desired.
Is it possible to write a flexible function expression?
I want to use input arguments to control the expression of function.
For example
input arg -> function
c(1,1) -> func1 = function(x) x+1
c(1,3,2) -> func2 = function(x) x^2+3*x+2
c(6,8,-1) -> func3 = function(x) 6*x^2+8*x-1
makepoly <- function(b)
{
p <- rev(seq_along(b) - 1)
function(x)
{
xp <- outer(x, p, '^')
rowSums(xp * rep(b, each=length(x)))
}
}
# x^2 + 2x + 3
f <- makepoly(1:3)
f(0:4)
[1] 3 6 11 18 27
Here is my take on this task
create_poly <- function(coef)
paste(rev(coef),
paste("x", seq_along(coef) - 1, sep = "^"),
sep = "*", collapse = " + ")
make_polyfun <- function(input) {
myfun <- paste("function(x)", create_poly(input))
eval(parse(text = myfun))
}
With the example the OP gave we have :
make_polyfun(c(1, 1))
## function(x) 1*x^0 + 1*x^1
## <environment: 0x243a540>
make_polyfun(c(1, 3, 2))
## function(x) 2*x^0 + 3*x^1 + 1*x^2
## <environment: 0x1bd46e0>
make_polyfun(c(6, 8, 1))
## function(x) 1*x^0 + 8*x^1 + 6*x^2
## <environment: 0x22a59c0>
You can use polynom
library(polynom)
as.polynomial(c(2,3,1))
2 + 3*x + x^2
as.polynomial(c(6,8,1)
1 + 8*x + 6*x^2
EDIT you can of course coerce the result to a function using the genericas.function.polynomial. better here you can use ,as.polylist` to create many polynomials given a list of coefficients lists. For example:
lapply(as.polylist(list(c(2,3,1),c(6,8,1),c(6,8,-1))),
as.function)
[[1]]
function (x)
{
w <- 0
w <- 1 + x * w
w <- 3 + x * w
w <- 2 + x * w
w
}
<environment: 0x00000000113bd778>
[[2]]
function (x)
{
w <- 0
w <- 1 + x * w
w <- 8 + x * w
w <- 6 + x * w
w
}
<environment: 0x0000000011524168>
[[3]]
function (x)
{
w <- 0
w <- -1 + x * w
w <- 8 + x * w
w <- 6 + x * w
w
}
<environment: 0x0000000011527f28>
It's not clear how general you want to be from OP. For the particular case of polynomials, you can do:
f = function(x, coeffs) {
sum(outer(x, seq_along(coeffs) - 1, `^`) * coeffs)
}
f(2, c(1,2,3)) # 1 + 2*x + 3*x^2, with x = 2
#[1] 17
I read this as the desire to make functions and I think the agstudy/eddi responses would probably do this, but I thought trying it from scratch might be instructive:
poly.maker <- function(coefs) { func <- function(x){} #empty func in x
body(func) <- parse(text= paste( seq_along(coefs),"*x^",
(length(coefs)-1):0,collapse="+" ) )
return(func) }
func2 <- poly.maker(c(1,2,3)) # return a function
func2(3) # now test it out
#[1] 18
Note I needed to swap the order to agree with the OP request, which I only noticed after getting different results than #dickoa. This seems less clunky:
poly.make2 <- function(coefs) { func <- function(x){}
body(func) <- bquote(sum(.(coefs)*x^.( (length(coefs)-1):0 ) ) )
return(func) }
func <- poly.make2(c(1,2,5))
func
#function (x)
#sum(c(1, 2, 5) * x^c(2L, 1L, 0L))
#<environment: 0x29023d508>
func(3)
#[1] 20
One liner:
polymaker2 <- function(coefs)
{
eval(parse(text=paste0( "function(x) sum(x^(",length(coefs)-1,":0) * ",capture.output(dput(coefs)),")" )))
}
Vectorized form:
polymaker3 <- function(coefs)
{
eval(parse(text=paste0( "function(x) colSums(t(outer(x, ",length(coefs)-1,":0, `^`))*",capture.output(dput(coefs)),")" )))
}