Let me describe the problem setting. The function I am depicting is a probability function and upon integration it's value would have to be equal to 1. So I will be dividing the result of the integration by 1 to give the value of C. So I can't assign value to C.
Have a look at the below code and error message -
> f <- function(x) (C*x*(exp(-x)))
> z=integrate(f, lower = 0, upper=Inf)
Error in C * x : non-numeric argument to binary operator
How am I supposed to define C here ?
Second Question- Can somebody figure what's wrong with value of z?
> f <- function(x) (x*(exp(-x)))
> z=integrate(f, lower = 0, upper=Inf)
> z
1 with absolute error < 6.4e-06
> 1/z
Error in 1/z : non-numeric argument to binary operator
Make C = 1 for when you compute the integral of the function. For that, you can make it an optional argument to your function with a default value:
f <- function(x, C = 1) C * x * exp(-x)
Then, compute:
z <- integrate(f, lower = 0, upper = Inf)
For the integral to be 1 with the real value for C, you need C * z == 1, i.e.:
C <- 1 / z$value
C
# [1] 1
As it turns out, the integral z is already equal to 1 so picking C = 1 was a lucky choice. You have nothing to do and you can just start using f as-is. Had it not been the case, I would have suggested to redefine f:
f_final <- function(x) f(x, C = 1 / z$value)
(Regarding your second question, you just had to look at the documentation for ?integrate and refer to the "Value" section.)
Related
Suppose I have a function with a kink. I want to derive a kink point, which in this case is 0.314. I tried optim but it does not work.
Here is an example. In general, I want to derive c. Of course, I could use brute force, but it is slow.
# function with a kink
f <- function(x, c){
(x >= 0 & x < c) * 0 + (x >= c & x <=1) * (sin(3*(x-c))) +
(x < 0 | x > 1) * 100
}
# plot
x_vec <- seq(0, 1, .01)
plot(x_vec, f(x_vec, c = pi/10), "l")
# does not work
optim(.4, f, c = pi/10)
This function has no unique minimum.
Here, a trick is to transform this function a little bit, so that its kink becomes a unique minimum.
g <- function (x, c) f(x, c) - x
x_vec <- seq(0, 1, 0.01)
plot(x_vec, g(x_vec, c = pi/10), type = "l")
# now works
optim(0.4, g, c = pi/10, method = "BFGS")
#$par
#[1] 0.3140978
#
#$value
#[1] -0.3140978
#
#$counts
#function gradient
# 34 5
#
#$convergence
#[1] 0
#
#$message
#NULL
Note:
In mathematics, if we want to find something, we have to first define it precisely. So what is a "kink" exactly? In this example, you refer to the parameter c = pi / 10. But what is it in general? Without a clear definition, there is no algorithm/function to get it.
Suppose I have the following system of equations:
a * b = 5
sqrt(a * b^2) = 10
How can I solve these equations for a and b in R ?
I guess this problem can be stated as an optimisation problem, with the following function... ?
fn <- function(a, b) {
rate <- a * b
shape <- sqrt(a * b^2)
return(c(rate, shape) )
}
In a comment the poster specifically asks about using solve and optim so we show how to solve this (1) by hand, (2) using solve, (3) using optim and (4) a fixed point iteration.
1) by hand First note that if we write a = 5/b based on the first equation and substitute that into the second equation we get sqrt(5/b * b^2) = sqrt(5 * b) = 10 so b = 20 and a = 0.25.
2) solve Regarding the use of solve these equations can be transformed into linear form by taking the log of both sides giving:
log(a) + log(b) = log(5)
0.5 * (loga + 2 * log(b)) = log(10)
which can be expressed as:
m <- matrix(c(1, .5, 1, 1), 2)
exp(solve(m, log(c(5, 10))))
## [1] 0.25 20.00
3) optim Using optim we can write this where fn is from the question. fn2 is formed by subtracting off the RHS of the equations and using crossprod to form the sum of squares.
fn2 <- function(x) crossprod( fn(x[1], x[2]) - c(5, 10))
optim(c(1, 1), fn2)
giving:
$par
[1] 0.2500805 19.9958117
$value
[1] 5.51508e-07
$counts
function gradient
97 NA
$convergence
[1] 0
$message
NULL
4) fixed point For this one rewrite the equations in a fixed point form, i.e. in the form c(a, b) = f(c(a, b)) and then iterate. In general, there will be several ways to do this and not all of them will converge but in this case this seems to work. We use starting values of 1 for both a and b and divide both side of the first equation by b to get the first equation in fixed point form and we divide both sides of the second equation by sqrt(a) to get the second equation in fixed point form:
a <- b <- 1 # starting values
for(i in 1:100) {
a = 5 / b
b = 10 / sqrt(a)
}
data.frame(a, b)
## a b
## 1 0.25 20
Use this library.
library("nleqslv")
You need to define the multivariate function you want to solve for.
fn <- function(x) {
rate <- x[1] * x[2] - 5
shape <- sqrt(x[1] * x[2]^2) - 10
return(c(rate, shape))
}
Then you're good to go.
nleqslv(c(1,5), fn)
Always look at the detailed results. Numerical calculations can be tricky. In this case I got this:
Warning message:
In sqrt(x[1] * x[2]^2) : NaNs produced
That just means the procedure searched a region that included x[1] < 0 and then presumably noped the heck back to the right hand side of the plane.
Let's say i have a function defined as the following in R:
> f <- function(x) 0.5*sin(x)*(x>=0)*(x<=pi)
i can do this to integrate it between 0 and pi:
> Integrate <- function(f,a,b) integrate(Vectorize(f),a,b)$value
> F <- Integrate(f,0,pi)
But if i want to evaluate and return some values of F i get this error:
> F(c(-100,0,1,2,pi,100))
Error in F(c(-100, 0, 1, 2, pi, 100)) :
function "F" is not found
i can understand that this is due to the fact, that my integrate <- function(f,a,b) returns a constant value C which is the result of the integration of f between a and b, but how can i return F as a function to be able to evaluate it's values as a vector and plot it ?
like in this case F should give 0 for any value less than 0 and 1 for any value bigger than pi and be variable between them.
Thanks.
Edit: just to sum it up more clearly: how can i define a function f(x) in [a,b] that will give me f(x) if x is in [a,b], 0 if xb ?
Try wrapping your function call in an sapply and have Integrate return a function.
Integrate <- function(f, a, b) function(x) if (x < a) 0 else if (x > b) 1 else integrate(Vectorize(f), a, x)$value
F <- Integrate(f, 0, pi)
sapply(c(-100,0,1,2,pi,100), F)
gives
[1] 0.0000000 0.0000000 0.2298488 0.7080734 1.0000000 1.0000000
I'm trying to create a factor from vector d that indicates whether each value of d is missing, less than threshhold, or greater than/equal to threshhold. I attempted with the following code, using the cases function from the memisc package.
threshhold = 5
d <- sample(c(1:10, NaN), 50, replace=TRUE)
d_case <- cases(
is.na(d),
d > threshhold,
d <= threshhold
)
and got a warning: In cases(is.na(d), d > threshhold, :
condition is.na(d) is never satisfied.
I've also tried using assignment operators,
d_case <- cases(
is.na(d) -> 0,
d > threshhold -> 1,
d <= threshhold -> 2
)
and got the same warning. I've checked, and d does contain NaN values, which is.na() should be returning as true (and is, when I check it outside of cases). Does anyone know why cases isn't working, or what I can do to get the indicator factor I need?
Look at ?cases according to the documenation you can do it like this
d <- c(-1:3,NA,1:2)
fun <- function(x){
cases(
is.na(x) -> 0,
x > threshhold -> 1,
x <= threshhold -> 2
)
}
d_case <- fun(d)
d_cases
How about:
addNA(as.factor(d>threshold))
....
Levels: FALSE TRUE <NA>
so I have an error...
f <- function(x){return(1)}
curve(f(x),0,100,xname="x")
Error in curve(f(x), 0, 100, xname = "x") :
'expr' did not evaluate to an object of length 'n'
Which is strange considering that
F <- function(x){return(0*x+1)}
curve(F(x),0,100,xname="x")
Works just fine... This informed me to think about how R treats data.frame()s.
a <- data.frame(1,2,3)
f(a)
# [1] 1
F(a)
# X1 X2 X3
# 1 1 1 1
Meaning that the Function Vectorize() will fix my problem.
Irregardless this is an acute example of the implicit decisions That R makes, which result in inconsistent behavior.
The problem is the function should return a vector of the same length as a parameter. In your case instead of n, the function always returns a vector of just one. The solution could be
f <- function(x){return(rep(1,length(x)))}