Here is my code:
Step1: Define a inverse function which I will use later
inverse = function (f, lower = -100, upper = 100) {
function (y) uniroot((function (x) f(x) - y), lower = lower, upper = upper)[1]
}
Step2: Here is my functions and their inverse:
F1<-function(x,m1,l,s1,s2){l*pnorm((x-m1)/s1)+(1-l)*pnorm((x+m1)/s2)}
F1_inverse = inverse(function(x) F1(x,1,0.1,2,1) , -100, 100)
F2<-function(x,m2,l,s1,s2){l*pnorm((x-m2)/s1)+(1-l)*pnorm((x+m2)/s2)}
F2_inverse = inverse(function(x) F1(x,1,0.1,2,1) , -100, 100)
Step3: Here is my final function which combines the above functions (I am sure the function is correct):
copwnorm<-function(x,y,l,mu1,mu2,sd1,sd2) {
(l*dnorm(((F1_inverse(pnorm(x))$root-mu1)/sd1))*
dnorm(((F2_inverse(pnorm(y))$root-mu2)/sd1)))
}
Step4: I want to create a contour plot for the function in Stepenter code here3:
x<-seq(-2,2,0.1)
y<-seq(-2,2,0.1)
z<-outer(x,y,copwnorm)
contour(x,y,z,xlab="x",ylab="y",nlevels=15)
Here is the problem comes in, when I tried to apply function outer(x,y,copwnorm), it gives me an error:invalid function value in 'zeroin'. May I ask how to solve this problem?
I believe it is a very commom misconception to assume that outer(x, y, FUN) calls the function parameter (FUN) once for each required pair x[i] and y[j]. Actually, outer calls FUN only once, after creating all possible pairs, combining every element of x with every element of y, in a manner similar to the function expand.grid.
I'll show that with an example: consider this function, which is a wrapper for the product and print a message every time it's called:
f <- function(x,y)
{
cat("f called with arguments: x =", capture.output(dput(x)), "y =", capture.output(dput(y)), "\n")
x*y
}
This function is "naturally" vectorized, so we can call it with vector arguments:
> f(c(1,2), c(3,4))
f called with arguments: x = c(1, 2) y = c(3, 4)
[1] 3 8
Using outer:
> outer(c(1,2), c(3,4), f)
f called with arguments: x = c(1, 2, 1, 2) y = c(3, 3, 4, 4)
[,1] [,2]
[1,] 3 4
[2,] 6 8
Notice the combinations generated.
If we can't guarantee that the function can handle vector arguments, there is a simple trick to ensure the function gets called only once for each pair in the combinations: Vectorize. This creates another function that calls the original function once for each element in the arguments:
> Vectorize(f)(c(1,2),c(3,4))
f called with arguments: x = 1 y = 3
f called with arguments: x = 2 y = 4
[1] 3 8
So we can make a "safe" outer with it:
> outer(c(1,2), c(3,4), Vectorize(f))
f called with arguments: x = 1 y = 3
f called with arguments: x = 2 y = 3
f called with arguments: x = 1 y = 4
f called with arguments: x = 2 y = 4
[,1] [,2]
[1,] 3 4
[2,] 6 8
In this case, the results are the same because f was written in a vectorized way, i.e., because "*" is vectorized. But if your function is not written with this in mind, using it directly in outer may fail or (worse) may give wrong results.
Related
f1<-function(x,y){
f2<-function(a,b){
print("f2")
return(a+b)}
f2(x,y)
print("f1")
return(x-y)}
f1(8,5)
I was trying above code to figure out the steps of operating function within function, so instead of writing two separate functions, I write the above code. But I can't get the output for a+b (which is 13)
[1] "f2"
[1] "f1"
[1] 3
#[1] 13, this output is missing.
How should the code be corrected? Thank you.
*additional question: when I only write x-y instead of return(x-y) at the last line of the function f1, I got the same output. Is simply write x-y a bad practice or accpetable?
-------------------------Update:
I just find out a way to get all the four outputs by changing the 4th line from return(a+b) to print(a+b)
or to make it more simple, only use the x,yarguments:
f1<-function(x,y) {
f2<-function() {
print("f2")
print(x+y)
}
f2()
print("f1")
x-y
}
while I still don't understand why using return(x+y) or simply x+y at the 4th line could not get the output of 13?
When an expression is on a line by itself it will automatically print if you do it at the R console but that does not happen if it is within a function or within an expression. Use cat or print for displaying.
To return two objects return a list containing both of them as shown at below.
The value of the last line that is run in a function is returned so you rarely need return.
f1a <- function(x, y) {
f2 <- function(a, b) {
print("f2")
a + b
}
print("f1")
list(x - y, f2(x, y))
}
result <- f1a(8, 5)
## [1] "f1"
## [1] "f2"
result[[1]]
## [1] 3
result[[2]]
## [1] 13
result
## [[1]]
## [1] 3
##
## [[2]]
## [1] 13
Other things we could do would be to replace the list(...) line in the code above with one of the following. (The c versions would only be used if we knew that the arguments were always scalars.)
list(f1 = x - y, f2 = f2(x, y)) # named list
c(x - y, f2(x, y)) # 2 element numeric vector
c(f1 = x - y, f2 = f2(x, y)) # 2 element named numeric vector
cbind(f1 = x - y, f2 = f2(x, y)) # matrix w column names
data.frame(f1 = x - y, f2 = f2(x, y)) # data.frame
I have written a function in R like this:
foo <- function(a, b = 1) {
...
}
But now I want to change the default argument b, like:
foo(b = 2)
This is a function of a in principle. But R doesn't allow this, which throws me an error.
How can I fix it?
Your code in foo(b = 2) is function application: if everything works as expected, it will give you a value rather than a function.
You can modify the default values of arguments using formals:
foo <- function(a, b = 1) {
a + b
}
formals(foo)$b <- 2
foo
#function (a, b = 2)
# {
# a + b
# }
If you don't want to modify your foo directly, there are several options:
1) Copy first, change later
foa <- foo
formals(foa)$b <- 42
One might think of using "formals<-" as a shortcut but that can be complicated as you need to supply the full list of arguments (using alist rather than list because the former can take an empty argument):
"formals<-"(foo, , list(b=2)) # trying it with `list`
function (b = 2) # we lost one argument!
{
a + b
}
"formals<-"(foo, , alist(a=, b=42)) # this one is better!
function (a, b = 42)
{
a + b
}
2) Use purr::partial or function(a) foo(a,b=42) as recommended in the other answer.
3) And a third way ... one can actually write a very simple function (I'll call it p2) that changes some of the default arguments of a function and returns the changed function:
p2 <- function(f, l){
formals(f)[names(l)] <- l
f
}
p2(foo, list(b=42)) # changing a default: function (a, b = 42) a+b
p2(foo, alist(b=)) # removing a default: function (a, b) a+b
p2(foo, list(c="bingo") # adding an argument: function (a, b = 2, c = "bingo") a+b
A modified version:
p3 <- function(f, ...){
l <- as.list(sys.call())[-(1L:2L)] # code from `alist`
formals(f)[names(l)] <- l
f
}
Now the usage becomes shorter:
p3(foo, b=43) # function (a, b = 43) a+b
p3(foo, b=) # function(a,b) a+b
Note that p2 and p3 won't work properly with generic functions such as mean and min. This is probably the reason why the code in purrr:partial is so much more complicated.
You can call foo as so: foo(a, b = whatever)
If you need to change the default b to the same value really often, you could make a new foo-related function.
You could either define a new function:
# partially substitute in a `b` value
goo <- purrr::partial(foo, b = 2, .first = FALSE)
# or, a bit more explicitly,
hoo <- function(a) {foo(a, b = 2)}
or construct a function builder/factory, that allows you to build as many foo-related functions as you like
foo_builder <- function(b = 1) {
function(a) {
# your definition of foo goes here
blah <- blah_f(a, b)
}
}
Now you can pass in a b value to foo_builder and it will return the equivalent function to foo(a, b = whatever_you_passed_to_foo_builder)
goo <- foo_builder(2)
goo(a = ...)
For example,
foo_builder <- function(b = 1){
function(a){
message(b)
a + b
}
}
Now when the internal function is defined by foo_builder, it takes the value of b that is available to the foo_builder environment. This is 1 by default, but can be changed.
For example,
# default
foo_builder()(1)
1
[1] 2
# with b=2 in the closure returned by foo_builder
b <- 2
fb <- foo_builder(b)
fb(1)
2
[1] 3
A commenter suggested that you ought to force the evaluation of b when you make closures this way; because of the following:
b <- 2
fb <- foo_builder(b)
b <- 3
fb(1)
# 3
# [1] 4
So maybe rewrite the foo_builder:
foo_builder <- function(b = 1){
force(b)
function(a){
message(b)
a + b
}
}
To extend the usability of a R function, we need to pass an argument of type function (FUN), Could you please demonstrate how to declare a function parameter inside in another function and how to call it. Like
MyOperation <- function(x, y, FUN){
int sum <- x+y
if (!missing(FUN)) sum<-FUN(sum)}
return sum
}
Res <- MyOperation(x=1, y=2, FUN=function(n){...})
You don't declare variables in R. Also you can specify a default value right in the formal argument list. You don't need to use missing in this situation.
This runs FUN(x + y) or returns x+y if FUN is not specified.
myOp2 <- function(x, y, FUN = identity) FUN(x + y)
myOp2(1, 2)
## [1] 3
myOp2(1, 3, sqrt)
## [1] 2
One enhancement might be to allow the function to be specified either as a function or as a character string:
myOp2a <- function(x, y, FUN = identity) {
FUN <- match.fun(FUN)
FUN(x + y)
}
myOp2a(1, 3, "sqrt")
## [1] 2
myOp2a(1, 3, sqrt)
## [1] 2
This sums x and y if FUN is not specified; otherwise, it runs FUN with the arguments x and y.
myOp3 <- function(x, y, FUN = sum) FUN(x, y)
myOp3(1, 2)
## [1] 3
myOp3(1, 2, min)
## [1] 1
You just have some basic R syntax problems there. There's no int in R, your function closing bracket was in the wrong place, return() is a function in R -- not a keyword. Check out
MyOperation<-function(x,y,FUN){
sum <- x+y
if (!missing(FUN)) sum<-FUN(sum)
return(sum)
}
MyOperation(x=1,y=2)
# [1] 3
MyOperation(x=1,y=2,FUN=function(n){n+100})
# [1] 103
Consider the following code
i = 3
j = i
i = 4 # j != i
However, what I want is
i = 3
f <- function(x, j=i)
x * j
i = 4
f(4) # 16, but i want it to be 12
In case you are wondering why I want to do this you could consider this code - the application is a multiple decrements model. The diagonals of a transition matrix are the sum of the other decrements in that row. I would like to define the decrements I need than calculate the other functions using those decrements. In this case, I only need uxt01 and uxt10 and from these I want to produce the functions uxt00 and uxt11. I wanted something that scales to higher dimensions.
Qxt <- matrix(c(uxt00=function(t=0,x=0) 0,
uxt01=function(t=0,x=0) 0.05,
uxt10=function(t=0,x=0) 0.07
uxt11=function(t=0,x=0) 0), 2, 2, byrow=TRUE)
Qxt.diag <- function(Qxt) {
ndecrements <- length(Qxt[1,])
for(index in seq(1, N, N+1)) { # 1, 4
Qxt[[index]] <- function(t=0, x=0, i=index, N=ndecrements) {
row <- ceiling(index/ndecr)
row.decrements <- seq( (row - 1)*N + 1, (row)*N)
other.decrements <- row.decrements[which(row.decrements != i]
-sum(unlist(lapply(Qxt.fns[[other.decrements]],
function(f) f(t,x))))
}
}
Qxt.fns
}
This can be done by assigning the default expression for the formal parameter j manually, after creating the function:
i <- 3;
f <- function(x,j) x*j;
f;
## function(x,j) x*j
formals(f);
## $x
##
##
## $j
##
##
formals(f)$j <- i;
f;
## function (x, j = 3)
## x * j
formals(f);
## $x
##
##
## $j
## [1] 3
##
i <- 4;
f(4);
## [1] 12
This is only possible because R is an awesome language and provides you complete read/write access to all three special properties of functions, which are:
The parse tree that comprises the body: body().
The formal parameters and their default values (which are themselves parse trees): formals().
The enclosing environment (which is used to implement closures): environment().
Assign it to a different variable if you want to reuse i:
default_value = i
f = function(x, j = default_value)
x * j
i = 4
f(4) # 12
of course, you should not let this variable just lying around — that’s as bad as the original code. You can make it “private” to the function, though, by defining both together in a local environment:
f = local({
default_value = i
function(x, j = default_value)
x * j
})
This question is a follow-up to a previous answer which raised a puzzle.
Reproducible example from the previous answer:
Models <- list( lm(runif(10)~rnorm(10)),lm(runif(10)~rnorm(10)),lm(runif(10)~rnorm(10)) )
lm1 <- lm(runif(10)~rnorm(10))
library(functional)
# This works
do.call( Curry(anova, object=lm1), Models )
# But so does this
do.call( anova, Models )
The question is why does do.call(anova, Models) work fine, as #Roland points out?
The signature for anova is anova(object, ...)
anova calls UseMethod, which should* call anova.lm which should call anova.lmlist, whose first line is objects <- list(object, ...), but object doesn't exist in that formulation.
The only thing I can surmise is that do.call might not just fill in ellipses but fills in all arguments without defaults and leaves any extra for the ellipsis to catch? If so, where is that documented, as it's definitely new to me!
* Which is itself a clue--how does UseMethod know to call anova.lm if the first argument is unspecified? There's no anova.list method or anova.default or similar...
In a regular function call ... captures arguments by position, partial match and full match:
f <- function(...) g(...)
g <- function(x, y, zabc) c(x = x, y = y, zabc = zabc)
f(1, 2, 3)
# x y zabc
# 1 2 3
f(z = 3, y = 2, 1)
# x y zabc
# 1 2 3
do.call behaves in exactly the same way except instead of supplying the arguments directly to the function, they're stored in a list and do.call takes care of passing them into the function:
do.call(f, list(1, 2, 3))
# x y zabc
# 1 2 3
do.call(f, list(z = 3, y = 2, 1))
# x y zabc
# 1 2 3
I think it is worth stressing that the names of the list elements do matter. Hadley mentioned it, but it can be an annoyance. Consider the next example:
x <- rnorm(1000)
y <- rnorm(1000)
z <- rnorm(1000) + 0.2
Models <- list()
Models$xy <- lm(z~x)
Models$yz <- lm(z~y)
# This will fail, because do.call will not assign anything to the argument "object" of anova
do.call(anova, Models)
# This won't
do.call(anova, unname(Models))
do.call passes the first element of the list to the first argument:
fun <- function(x,...) {
print(paste0("x=",x))
list(x, ...)
}
do.call(fun, list(1,2))
# [1] "x=1"
# [[1]]
# [1] 1
#
# [[2]]
# [1] 2