I am using the approxfun() function to get linear interpolation. I want to write a function which takes the results of approxfun() then shifts and scales it by an amount that I specify. I need to be able to call this new function just like I would call any other function.
Simplified version of my attempt:
set.seed(42)
x = rnorm(50)
y = rnorm(50, 5, 2)
fhat = approxfun(x, y, rule = 2)
new_function = function(fhat, a, b){
new_fhat <- (function(fhat, a, b) a * fhat() + b)()
return(new_fhat)
}
I expect the results to be the same as
2 * fhat(1) + 3
but instead when I run my function
new_function(fhat, a = 2, b = 3)
I get an error message:
*Error in (function(fhat, a, b) a * fhat() + b)() :
argument "a" is missing, with no default*
You have four problems:
new_fhat isn't passed the values of a and b from the new_function call, and can't see them because you are creating new ones in your function definition. This is actually a bit of a red herring because...
The function you return should only have a single argument - the point at which you want to evaluate it.
You are attempting to evaluate new_fhat immediately.
You are trying to call fhat without an argument.
The solution is:
new_function = function(fhat, a, b){
new_fhat <- function(v) a * fhat(v) + b
return(new_fhat)
}
Results:
fhat(1)
[1] 5.31933
new_function(fhat,a=2,b=3)(1)
[1] 13.63866
2 * fhat(1) + 3
[1] 13.63866
This is equivalent to the code in the question, but simplified:
new_function = function(fhat, a, b) {
a * fhat() + b
}
But this is not correct, because in the posted code fhat requires an argument. For example, to make new_function(fhat, a = 2, b = 3) return the same results as 2 * fhat(1) + 3, you would have to add the parameter 1 inside the function:
new_function = function(fhat, a, b) {
a * fhat(1) + b
}
Related
I'm trying to estimate parameters that will maximize the likelihood of a certain event. My objective function looks like that:
event_prob = function(p1, p2) {
x = ((1-p1-p2)^4)^67 *
((1-p1-p2)^3*p2)^5 *
((1-p1-p2)^3*p1)^2 *
((1-p1-p2)^2*p1*p2)^3 *
((1-p1-p2)^2*p1^2) *
((1-p1-p2)*p1^2*p2)^2 *
(p1^3*p2) *
(p1^4)
return(x)
}
In this case, I'm looking for p1 and p2 [0,1] that will maximize this function. I tried using optim() in the following manner:
aaa = optim(c(0,0),event_prob)
but I'm getting an error "Error in fn(par, ...) : argument "p2" is missing, with no default".
Am I using optim() wrong? Or is there a different function (package?) I should be using for multi-parameter optimization?
This problem can in fact be solved analytically.
The objective function simplifies to
F(p1,p2) = (1-p1-p2)^299 * p1^19 * p2^11
which is to be maximised over the region
C = { (p1,p2) | 0<=p1, 0<=p2, p1+p2<=1 }
Note that F is 0 if p1=0 or p2 =0 or p1+p2 = 1, while if none of those are true then F is positive. Thus the maximum of F occurs in the interior of C
Taking the log
f(p1,p2) = 299*log(1-p1-p2) + 19*log(p1) + 11*log(p2)
In fact it is as easy to solve the more general problem: maximise f over C where
f( p1,..pN) = b*log( 1-p1-..-pn) + Sum{ a[j]*log(p[j])}
where b and each a[j] is positive and
C = { (p1,..pN) | 0<pj, j=1..N and p1+p2+..pN<1 }
The critical point occurs where all the partial derivatives of f are zero, which is at
-b/(1-p1-..-pn) + a[j]/p[j] = 0 j=1..N
which can be written as
b*p[j] + a[j]*(p1+..p[N]) = a[j] j=1..N
or
M*p = a
where M = b*I + a*Ones', and Ones is a vector with each component 1
The inverse of M is
inv(M) = (1/b)*(I - a*Ones'/(b + Ones'*a))
Thus the unique critical point is
p^ = inv(M)*a
= a/(b + Sum{i|a[i]})
Since there is a maximum, and only one critical point, the critical point must be the maximum.
Based on Erwin Kalvelagen's comment: Redefine your function event_prob:
event_prob = function(p) {
p1 = p[1]
p2 = p[2]
x = ((1-p1-p2)^4)^67 *
((1-p1-p2)^3*p2)^5 *
((1-p1-p2)^3*p1)^2 *
((1-p1-p2)^2*p1*p2)^3 *
((1-p1-p2)^2*p1^2) *
((1-p1-p2)*p1^2*p2)^2 *
(p1^3*p2) *
(p1^4)
return(x)
}
You may want to set limits to ensure that p1 and p2 fulfill your constraints:
optim(c(0.5,0.5),event_prob,method="L-BFGS-B",lower=0,upper=1)
I need to find evaluate the following function, including an integral, in R:
Probability density functions involving multiple variables, where u = t - y.
The problem I'm running into is that while the input variables of the function as a whole are x and t, the integral needs to be evaluated over the variable u = t - y. The functions f and m' both return values, but I don't know how to make it so that R evaluates the integral over this u rather than x or T.
I currently have the following, but this doesn't return the values I'm supposed to be getting, so I'm wondering if I did it properly?
Thank you in advance!
a = 3
b = 10
T = 2.6
mprime = function(x){
return (1/x)
}
f = function(x){
if (a <= x & x <= b){
return (1/(b-a))
}
else{
return (0)
}
}
toIntegrate = function(u){
return (f(u + x)*mprime(T-u))
}
solution = function (x, T){
return (f(T + x)) + (integrate(toIntegrate(T-y), 0, T))
}
solution(5,T)
There are a few errors in your code:
f and other functions you'll be using in your integration need to be vectorised, i.e. it should take a vector as an input and return a vector as an output.
toIntegrate uses x which is neither a global variable nor an argument.
return is a function, so only the expression between parentheses are returned. As a result, your integral would not be evaluated because your function would return f(T+x)
The first argument to integrate should be toIntegrate, not toIntegrate(T-y)
mprime will return infinity for u=t, so the limits may need to be adjusted.
a = 3
b = 10
t = 2.6
mprime = function(x){
return (1/x)
}
f = function(x){
ifelse(a <= x & x <= b,1/(b-a),0)
}
toIntegrate = function(u,x,t){
return (f(u + x)*mprime(t-u))
}
solution = function (x, t){
return(f(t + x) + integrate(toIntegrate, 0, t,x=x,t=t,stop.on.error = F)$value)
}
solution(5,T)
I want to code a function that takes in a number and returns a function with that number as a parameter. I want to later find the roots of this function it outputs.
fooToOptimze <- function(PD) {
f <- function(C, k) { 0.089 * exp(1.6234 * PD) - C * exp(k * PD)}
return(f)
}
However, this way, I get:
fooToOptimize(.5)
OUTPUT
function(C, k) { 0.089 * exp(1.6234 * PD) - C * exp(k * PD)}
How should I approach this?
You don't have to use purrr for this. Your function seems to look OK. Again, suppose you want to create a function that takes a and b as parameters and returns a function for evaluating ax+b. Here is what you do:
lin <- function(a,b){
function(x) a*x + b
}
Then lin(1,1)(1) will give you 1*1 + 1 = 2. lin(1,0)(x) will just give you the input value back for any x.
I am solving a task for my R online course. The task is to write a function, that solves the quadratic equation with the Lagrange resolvents, or:
x1<--p/2+sqrt((p/2)^2-q)
x2<--p/2-sqrt((p/2)^2-q)
1) If the arguments are non-numeric, the function should return an explained error (or why the error has happend). 2) If there are missing arguments, the function should return an explained error (different from the default). 3) If x1 and x2 are complex numbers (for example if p=-4 and q=7, then x1=2+i*1.73 and x2=2-i*1.73), the function should should also solve the equation instead of generating NaNs and return a warning message, that the numbers are complex. Maybe if I somehow cast it to as.complex, but I want this to be a special case and don't want to cast the basic formula.
My function looks like this:
quadraticEquation<-function(p,q){
if(!is.numeric(c(p,q)))stop("p and q are not numeric") #partly works
if(is.na(c(p,q)))stop("there are argument/s missing") #does not work
x1<--p/2+sqrt((p/2)^2-q)
x2<--p/2-sqrt((p/2)^2-q)
#x1<--p/2+sqrt(as.complex((p/2)^2-q)) works, but I want to perform this only in case the numbers are complex
#x2<--p/2-sqrt(as.complex((p/2)^2-q))
return (c(x1,x2))
}
When testing the function:
quadraticEquation(4,3) #basic case is working
quadraticEquation(TRUE,5) #non-numeric, however the if-statement is not executed, because it assumes that TRUE==1
quadraticEquation(-4,7) #complex number
1) how to write the function, so it assumes TRUE (without "") and anything that is non-numeric as non-numeric?
2) basic case, works.
3) how can I write the function, so it solves the equation and prints the complex numbers and also warns that the numbers are complex (warning())?
Something like this?
quadraticEquation <- function(p, q){
## ------------------------% chek the arguments %---------------------------##
if(
missing(p) | missing(q) # if any of arguments is
){ # missing - stop.
stop("[!] There are argument/s missing")
}
else if(
!is.numeric(p) | !is.numeric(q) | any(is.na(c(p, q))) # !is.numeric(c(1, T))
){ # returns TRUE - conver-
stop("[!] Argument/s p or/and q are not numeric") # tion to the same type
}
## --------------------% main part of the function %--------------------------##
r2 <- p^2 - 4*q # calculate r^2,
if(r2 < 0){ # if r2 < 0 (convert) it
warning("equation has complex roots") # to complex and warn
r2 <- as.complex(r2)
}
# return named roots
setNames(c(-1, 1) * sqrt(r2)/2 - p/2, c("x1", "x2"))
}
quadraticEquation() # No arguments provided
#Error in quadraticEquation() : [!] There are argument/s missing
quadraticEquation(p = 4) # Argument q is missing
#Error in quadraticEquation(p = 4) : [!] There are argument/s missing
quadraticEquation(p = TRUE, q = 7) # p is logical
#Error in quadraticEquation(p = TRUE, q = 7) :
#[!] Argument/s p or/and q are not numeric
quadraticEquation(p = NA, q = 7) # p is NA
#Error in quadraticEquation(p = NA, q = 7) :
#[!] Argument/s p or/and q are not numeric
quadraticEquation(p = 7, q = -4) # real roots
# x1 x2
#-7.5311289 0.5311289
quadraticEquation(p = -4, q = 7) # complex roots
# x1 x2
#2-1.732051i 2+1.732051i
#Warning message:
#In quadraticEquation(p = -4, q = 7) : equation has complex roots
When you write is.numeric(c(p, q)), R first evaluates c(p, q) before determining whether it is numeric or not. In particular if p = TRUE and q = 3, then c(p, q) is promoted to the higher type: c(1, 3).
Here is a vectorized solution, so if p and q are vectors instead of scalars the result is also a vector.
quadraticEquation <- function(p, q) {
if (missing(p)) {
stop("`p` is missing.")
}
if (missing(q)) {
stop("`q` is missing.")
}
if (!is.numeric(p)) {
stop("`p` is not numeric.")
}
if (!is.numeric(q)) {
stop("`q` is not numeric.")
}
if (anyNA(p)) {
stop("`p` contains NAs.")
}
if (anyNA(q)) {
stop("`q` contains NAs.")
}
R <- p^2 / 4 - q
if (min(R) < 0) {
R <- as.complex(R)
warning("Returning complex values.")
}
list(x1 = -p / 2 + sqrt(R),
x2 = -p / 2 - sqrt(R))
}
Also, you should never write x1<--p/2. Keep spaces around infix operators: x1 <- -p/2.
I'm trying to take the derivative of an expression:
x = read.csv("export.csv", header=F)$V1
f = expression(-7645/2* log(pi) - 1/2 * sum(log(w+a*x[1:7644]^2)) + (x[2:7645]^2/(w + a*x[1:7644]^2)),'a')
D(f,'a')
x is simply an integer vector, a and w are the variables I'm trying to find by deriving. However, I get the error
"Function '[' is not in Table of Derivatives"
Since this is my first time using R I'm rather clueless what to do now. I'm assuming R has got some problem with my sum function inside of the expression?
After following the advice I now did the following:
y <- x[1:7644]
z <- x[2:7645]
f = expression(-7645/2* log(pi) - 1/2 * sum(log(w+a*y^2)) + (z^2/(w + a*y^2)),'a')
Deriving this gives me the error "sum is not in the table of derivatives". How can I make sure the expression considers each value of y and z?
Another Update:
y <- x[1:7644]
z <- x[2:7645]
f = expression(-7645/2* log(pi) - 1/2 * log(w+a*y^2) + (z^2/(w + a*y^2)))
d = D(f,'a')
uniroot(eval(d),c(0,1000))
I've eliminated the "sum" function and just entered y and z. Now, 2 questions:
a) How can I be sure that this is still the expected behaviour?
b) Uniroot doesn't seem to like "w" and "a" since they're just symbolic. How would I go about fixing this issue? The error I get is "object 'w' not found"
This should work:
Since you have two terms being added f+g, the derivative D(f+g) = D(f) + D(g), so let's separate both like this:
g = expression((z^2/(w + a*y^2)))
f = expression(- 1/2 * log(w+a*y^2))
See that sum() was removed from expression f, because the multiplying constant was moved into the sum() and the D(sum()) = sum(D()). Also the first constant was removed because the derivative is 0.
So:
D(sum(-7645/2* log(pi) - 1/2 * log(w+a*y^2)) + (z^2/(w + a*y^2)) = D( constant + sum(f) + g ) = sum(D(f)) + D(g)
Which should give:
sum(-(1/2 * (y^2/(w + a * y^2)))) + -(z^2 * y^2/(w + a * y^2)^2)
expression takes only a single expr input, not a vector, and it is beyond r abilities to vectorize that.
you can also do this with a for loop:
foo <- c("1+2","3+4","5*6","7/8")
result <- numeric(length(foo))
foo <- parse(text=foo)
for(i in seq_along(foo))
result[i] <- eval(foo[[i]])