evaluating an integral depending on two parameters
A <- 0.0004
B <- 0.0013
c <- 1.0780
f1 <- function(x) {
f2 <- function(s) {
A + B * c^(x+s)
}
return(f2)
}
tpx <- function(t,x) {
exp(-integrate(f1(x), lower=0, upper=t)$value)
}
i get
> tpx(1,1)
[1] 0.9981463
for the ordered pair (1,1). when using the colon operator
> tpx(1,1:2)
[1] 0.9980945
Warning messages:
1: In x + s :
longer object length is not a multiple of shorter object length
2: In x + s :
longer object length is not a multiple of shorter object length
3: In x + s :
some error messages occur. is it possible to adjust the integration variable s? what causes the output right before the warning messages? it is neither
> tpx(1,1)
[1] 0.9981463
nor
> tpx(1,2)
[1] 0.998033
i suppose i get something wrong :S
You can use the following
sapply(1:2, tpx, t = 1)
Why?
The error is caused because: integrate expects f to be (quote from ?integrate)
an R function taking a numeric first argument and returning a numeric vector of the same length. Returning a non-finite element will generate an error.
But
> s = 1
> A + B * c^(1:2+s)
[1] 0.001910709 0.002028545
is of length 2 whereas s is of length 1.
sapply supplies one elements at a time the f1 and combines the result afterwards. That's why it works.
Comment:
You can also simplify your f1, f2 and tpx function as follows:
f1 <- function(s, x, A, B, c){
A + B * c^(x+s)
}
tpx <- function(x,t){
exp(-integrate(f1, lower=0, upper=t, x, A, B, c)$value)
}
Again quoting from ?integrate
... - additional arguments to be passed to f.
Meaning that the parameter x, A, B, c will be passed to f1 and only the first argument will be used by the integration.
Just do tpx = Vectorize(tpx) much easier than apply functions
Related
I am new to R and trying to understand this function call below:
mle_mos <- function (n, m1, m2, x, x1, x2, initial, iters)
mvnewton (function (p) log_likelihood_gradient(p,n,m1,m2,x,x1,x2),
function (p) -fisher_information(p,n,m1,m2,x,x1,x2),
initial, iters)
mvnewton <- function (f, g, x, n)
{
print(f)
if (n < 1)
stop("invalid number of iterations")
for (i in 1:n) {
cat("\nAt iteration",i,":\n\n")
cat("x =",x,"\n")
cat("f(x) =",f(x),"\n")
cat("g(x) =\n")
print(g(x));
x <- x - solve(g(x),f(x)) # computes inverse of g(x) times
f(x)
}
x
}
mvnnewton takes
(function (p) log_likelihood_gradient(p,n,m1,m2,x,x1,x2)
as the first parameter. Where is p getting it's value from? Where is it defined? Can someone explain where p is getting a value to be passed into log_likelihood_gradient as a parameter? I have been googling for the past 2 days and reading up a lot of stuff but am still not clear that I understand this properly.
Arguments
If we have a function fun
fun <- function(z) z+1
and then we call it
fun(1)
1 is said to be the actual argument and z is said to be the formal argument. The formal argument takes on the value of the actual argument so z takes on the value 1. (There are some technicalities which we have glossed over but these do not affect the situation in the question.)
mvnewton
When mvnewton is called the caller passes to it four actual arguments:
function (p) log_likelihood_gradient(p,n,m1,m2,x,x1,x2)
function (p) -fisher_information(p,n,m1,m2,x,x1,x2)
initial
iters
Note that the first two arguments are functions. It does not pass the result of calling the functions but passes the functions themselves.
Now within mvnewton these 4 actual arguments correspond to the formal arguments f, g, x and n so when mvnewton refers to f it is really referring to
function (p) log_likelihood_gradient(p,n,m1,m2,x,x1,x2)
Also within mvnewton the function f is called with actual argument x and x corresponds to formal argument p within f (and similarly for g).
Example
For example, suppose we call
f <- function(x) x^2
g <- function(x) 2*x
mvnewton(f, g, 1, 20)
Then x is 1 and the first time f(x) and g(x) are called within mvnewton they are called as f(1) and g(1) and within f and g the formal argument p takes the value 1. mvnewton then updates x to a new value, calls f and g again with the new value of x and so on.
I'd like to be able to pass current arguments in a function to another function without individually listing each of the arguments. This is for a slightly more complex function which will have about 15 arguments with potentially more arguments later added (it's based on an API for data which might have more complex data added later):
f_nested <- function(a, b, ...) {
c <- a + b
return(c)
}
f_main <- function(a, b) {
d <- do.call(f_nested, as.list(match.call(expand.dots = FALSE)[-1]))
c <- 2 / d
return(c)
}
f_main(2, 3)
#> [1] 0.4
sapply(2:4, function(x) f_main(x, 4))
#> Error in (function (a, b, ...) : object 'x' not found
Created on 2019-06-28 by the reprex package (v0.3.0)
The first call to f_main(2, 3) produces the expected result. However, when iterating over a vector of values with sapply an error arises that the object was not found. I suspect my match.call() use is not correct and I'd like to be able to iterate over my function.
I'll borrow from lm's used of match.call, replacing the first element with the next function. I think one key is to call eval with the parent.frame(), so that x will be resolved correctly.
# no change
f_nested <- function(a, b, ...) {
c <- a + b
return(c)
}
# changed, using `eval` instead of `do.call`, reassigning the function name
f_main <- function(a, b) {
thiscall <- match.call(expand.dots = TRUE)
thiscall[[1]] <- as.name("f_nested")
d <- eval(thiscall, envir = parent.frame())
c <- 2 / d
return(c)
}
sapply(2:4, function(x) f_main(x, 4))
# [1] 0.3333333 0.2857143 0.2500000
As #MrFlick suggested, this can be shortened slightly with:
f_main <- function(a, b) {
thiscall <- match.call(expand.dots = TRUE)
thiscall[[1]] <- as.name("f_nested")
d <- eval.parent(thiscall)
c <- 2 / d
return(c)
}
From http://adv-r.had.co.nz/Functions.html or R: What are operators like %in% called and how can I learn about them? I learned that it is possible to write own "binary operators" or "infix functioncs" using the %-sign.
One example would be
'%+%' <- function(a, b) a*b
x <- 2
y <- 3
x %+% y # gives 6
But is it possible to use them in a generic way if they are from a pre-defined class (so that in some cases I don't have to use the %-sign)? For exampple x + y shall give 6 if they are from the class prod.
Yes, this is possible: use '+.<class name>' <- function().
Examples
'+.product' <- function(a, b) a * b
'+.expo' <- function(a, b) a ^ b
m <- 2; class(m) <- "product"
n <- 3; class(n) <- "product"
r <- 2; class(r) <- "expo"
s <- 3; class(s) <- "expo"
m + n # gives 6
r + s # gives 8
safety notes
The new defined functions will be called if at least one of the arguments is from the corresponding class m + 4 gives you 2 * 4 = 8 and not 2 + 4 = 6. If the classes don't match, you will get an error message (like for r + m). So all in all, be sure that you want to establish a new function behind such basic functions like +.
Consider an example:
I want to pass a function with or without parameters to another function and use it in the following way:
genfx <- function(fx, fy, M, fs, ...){
a <- 1
b <- fx(a)
...
}
When fx = dunif it works, but how can I pass additional parameters for fx, for example, dunif(min=-0.5, max-0.5))? Is it possible to do it without specifying additional set of parameters to genfx?
Without more specifics, and we may not need them, the simplest case is just to insert ... into the call to fx, as if the ... were just another argument:
genfx <- function(fx, fy, M, fs, ...){
a <- 1
b <- fx(a, ...)
## more code here
}
E.g.:
genfx <- function(fx, ...){
a <- 1
b <- fx(a, ...)
b
}
> genfx(dunif)
[1] 1
> genfx(dunif, min = -0.5, max = 1.5)
[1] 0.5
(Note I removed the other arguments for simplicity in the example. This wasn't necessary though in this case.)
Here is one way with pryr package
library(pryr)
genfx <- function(fx) {
a <- 1
b <- fx(a)
b
}
myDunif <- partial(dunif, min=-0.5, max=0.5)
genfx(dunif)
[1] 1
genfx(myDunif)
[1] 0
partial just prepares a function with partially complete list of arguments. Handy in situations like this.
This is my code. The kum.loglik function returns negative loglikelihood and takes two arguments a and b. I need to find a and b that minimize this function using optim function. (n1,n2,n3 is pre-specified and passed to optim function.
kum.loglik = function(a, b, n1, n2, n3) {
loglik = n1*log(b*beta(1+2/a,b)) + n2 * log(b*beta(1+2/a,b)-2*b*beta(1+1/a,b)+1) +
n3 * log(b*beta(1+1/a,b)-b*beta(1+2/a,b))
return(-loglik)
}
optim(par=c(1,1), kum.loglik, method="L-BFGS-B",
n1=n1, n2=n2, n3=n3,
control=list(ndeps=c(5e-4,5e-4)))
This code should work well but it gives error message
Error in b * beta(1 + 2/a, b) : 'b' is missing
What is wrong in this code?
The problem is (straight from the optim help):
fn: A function to be minimized (or maximized), with first
argument the vector of parameters over which minimization is
to take place.
Your kum.loglik function needs to take a vector v which you pull the parameters out of, e.g.:
kum.loglik=function(v) { a = v[1]; b = v[2]; ...}
I always use the following, it gives you the best results
p0 <- c(a,b) #example vector of starting values
m <- optim(p0, loglik, method="BFGS", control=list(fnscale=-1, trace=10),
hessian=TRUE, x=data.frame)
#for table of results
rbind(m$par, sqrt(diag(solve(-m$hessian))))