I tried to define the following function but failed. Any suggestions will be welcome.
H = list()
H[[1]] = function(x) 1
for(i in 2:4) H[[i]] = function(x) H[[i-1]](x)*x+1
> H
[[1]]
function (x)
1
[[2]]
function (x)
H[[i - 1]](x) * x + 1
[[3]]
function (x)
H[[i - 1]](x) * x + 1
[[4]]
function (x)
H[[i - 1]](x) * x + 1
> H[[1]](1)
1
> H[[2]](1)
Too Deep Nesting
Instead of defining a set of functions recursively, define a single recursive function:
H <- function(x, n) {
if (n == 1) 1 else H(x, n-1) * x + 1
}
Then, H(x, n) returns the same as your H[[n]](x).
For completeness sake: your approach with the for loop does not work because each function depends on the specific value which was assigned to i at the moment the function was generated.
At the end of the loop i is set to 4. When you call H[[2]](10) R tries to compute H[[i-1]](10) * 10 + 1 = H[[3]](10) * 3 + 1 = ... which end in an infinite recursion.
Simply put, R does not remember that at the moment H[[2]] was defined i was equal to 2.
Related
Summary of problem
My objective is to create a function called newton.raphson to implement the Newton-Raphson root-finding algorithm.
Root Finding Algorithm: x1 = X0 - f(xo)/f'(x0)
I have 2 arguments:
iter = number of iteration (value = 10^5)
epsilon = for the tolerance (value = 10^-10)
Can not depend on variables outside of the function
newton.raphson <- function(f, x0, iter=1e5, epsilon=1e-10) {
x <- x0
h <- 1e-5
for (t in 1:iter) {
drvt <- f((x+h)) - f((x-h)) / (2 * h)
update <- x - f(x)/ drvt
if (abs(update) < epsilon) {
break
}
x <- update
}
root <- x
return(root)
}
# Define some function to test
f <- function(x) {
x^2 - 4 * x - 7
}
I get the following results:
> newton.raphson(f, 0)
[1] 2.000045
> newton.raphson(f, 3)
[1] 5.000024
But results should be:
-1.316625
5.316625
Your derivative calculation is a little bit broken - you forgot parenthesis around the difference between f(x+h) and f(x-h):
drvt <- ( f(x+h) - f(x-h) ) / (2 * h)
Also, you should compare the difference between the old and new root approximation to the tolerance. In order to make things more clear, rename your misleading update variable to something like new.x. Then, your should check if (abs(new.x - x) < epsilon).
Basically, I have
x<-rnorm(5).
I write a vector which takes integers 1 <= n <= 5 then returns in a vector the result from the series (1/n) * sum_{i=1}^n (1/x_i)
so
n=1 -> 1 * 1/x_1
n=2 -> (1/2) * ( 1/(x_1 + x_2) )
n=3 -> (1/3) * ( 1/(x_1 + x_2 + x_3) )
n=4 -> (1/4) * ( 1/(x_1 + x_2 + x_3 + x_4) )
I wrote this function:
series <- function(n){
n=seq(1,5,1)
x<-rnorm(length(n))
print(x)
return ( (1/n)* (1/sum(x[1:length(x[n])])) )
}
But the result is not true, for example
> series(5)
[1] 1.17810059 0.85472777 -0.55077392 -0.03856963 -0.19404827
[1] 0.8003608 0.4001804 0.2667869 0.2000902 0.1600722
for n=2 -> 1/2 * 1/x_1 + 1/x_2 = (1/2) * (1/(1.17810059+ 0.85472777)) but unfortunately, the result according to my code is 0.4001804!
P.S: I want to write the code without loops and without any function needs calling a library! just to define a simple function using the basic known functions in R and then I can save the result, if needed using Vectorize() or outer()
The sum() function is not vectorized. It collapsing everything down to a single value. instead, you can use cumsum() to get the cumulative some of all the values in the vector thus far.
series <- function(n){
n <- seq(1,5,1)
x <- rnorm(length(n))
print(x)
return((1/n)* (1/cumsum(x)))
}
Building on the basic idea from #MrFlick, you can also do:
1/seq_along(x) * 1/cumsum(x)
[1] -1.7841988 -0.6323886 0.4339966 0.2981289 0.2066433
I have problems with the coding of a function to optimize in which there are two summations and one production, all with different indexing. I split the code into two functions for simplicity.
In the first function j goes from 0 to k:
w = function(n,k,gam){
j = 0:k
w = (1 / factorial(k)) * n * sum(choose(k, j * gam))
return(w)}
In the second function k goes from 0 to n (that is fixed to 10); instead the production goes from 1 to length(x):
f = function(gam,del){
x = mydata #vector of 500 elements
n = 10
k = 0:10
for (i in 0:10)
pdf = prod( sum( w(n, k[i], gam) * (1 / del + (n/x)^(n+1))
return(-pdf)}
When I try the function I obtain the following error:
Error in 0:k : argument of length 0
Edit: This is what I am tryig to code
where I want to maximize L(d,g) using optim and:
and n is fixed to a specific value.
Solution
Change for (i in 0:10) to for ( i in 1:11 ). Note: When I copied and ran your code I also noticed some unrelated bracket/parentheses omissions you may need to fix also.
Explanation
Your problem is that R uses a 1-based indexing system rather than a 0-based one like many other programming languages or some mathematical formulae. If you run the following code you'll get the same error, and it pinpoints the problem:
k = 0:10
for ( i in 0:10 ) {
print(0:k[i])
}
Error in 0:k[i] : argument of length 0
You get an error on the first iteration because there is no 0 element of k. Compare that to the following loop:
k = 0:10
for ( i in 1:11 ) {
print(0:k[i])
}
[1] 0
[1] 0 1
[1] 0 1 2
[1] 0 1 2 3
[1] 0 1 2 3 4
[1] 0 1 2 3 4 5
[1] 0 1 2 3 4 5 6
[1] 0 1 2 3 4 5 6 7
[1] 0 1 2 3 4 5 6 7 8
[1] 0 1 2 3 4 5 6 7 8 9
[1] 0 1 2 3 4 5 6 7 8 9 10
Update
Your comment to the answer clarifies some additional information you need:
Just to full understand everything, how do I know in a situation like
this that R is indexing the production on x and the summation on k?
The short answer is that it depends on how you nest your loops and function calls. In more detail:
When you call f(), you start a for loop over the elements of k, so R is indexing the block of code within the for loop (everything in the braces in my re-formatted version of f() below) "on" k. For every element in k, you assign prod(...) to pdf (Side note: I don't know why you're re-writing over pdf in every iteration of this loop)
sum( w(n, k[i], gam) * gamma(1 / del + k[i]) * s^(n + 1)) produces a vector of length max(length(w(n, k[i], gam)), length(s)) (side note: Beware of recycling! -- see Section 2.2 of "An Introduction to R"); prod(sum( w(n, k[i], gam) * gamma(1 / del + k[i]) * s^(n + 1))) effectively indexes over the elements of that vector
w(n, k[i], gam) * gamma(1 / del + k[i]) * s^(n + 1) produces a vector of length max(length(w(n, k[i], gam)), length(s)); sum( w(n, k[i], gam) * gamma(1 / del + k[i]) * s^(n + 1)) effectively indexes over the elements of that vector
Etc.
What you're indexing over, explicitly or implicitly through vectorized operations, depends on which level of nested loops or function calls you're talking about. You may need some careful thinking and planning about when you want to index over what, which will tell you how you need to nest things. Put the operation whose indices should vary fastest on the innermost call. For example, in effect, prod(1:3 + sum(1:3)) will index over sum(1:3) to produce that sum first then index over 1:3 + sum(1:3) to produce the product. I.e., sum(1:3) = 1 + 2 + 3 = 6, then prod(1:3 + sum(1:3)) = (1 + 6) * (2 + 6) * (3 + 6) = 7 * 8 * 9 = 504. It's just like how parentheses work in mathematics.
Also, another side note, I wouldn't refer to global variables from within a function as you do in f() -- I've highlighted below in your code where you do that and offered an alternative that doesn't do it.
f = function(gam, del){
x = mydata # don't refer to a global variable "mydata", make it an argument
n = 10
s = n / x
k = 1:11
for (i in 1:11){
pdf = prod( sum( w(n, k[i], gam) * gamma(1 / del + k[i]) * s^(n + 1)))
}
return(-pdf)
}
# Do this instead
# (though there are still other things to fix,
# like re-writing over "pdf" eleven times and only using the last value)
f = function(gam, del, x, n = 10) {
s = n / x
s = n / x
k = 0:10
for (i in 1:11){
pdf = prod( sum( w(n, k[i], gam) * gamma(1 / del + k[i]) * s^(n + 1)))
}
return(-pdf)
}
bquote function allows to evaluate parts of the expression which are wrapped in .() call. For example,
a <- 2
b <- 100
bquote(.(2 * a) * x + .(log10(b)))
would return
4 * x + 2
I want to rewrite this function to evaluate everything except for things inside .() call. This is the desired behavior:
a <- 2
b <- 100
bquote(2 * a * .(x) + log10(b))
> 4 * x + 2
I understand that to do so I have to go over the abstract syntax tree and evaluate brunches without .() call in them but I couldn't handle all this recursion.
Could you help me to write such a function?
subst will substitute all variables except those within .(...) and the simplify function will simplify sub-trees that have no variables -- omit the simplify part if simplification is not needed. No packages are used.
subst <- function(e) {
if (typeof(e) == "language") {
if (identical(e[[1]], as.name("."))) e[[2]]
else {
if (length(e) > 1) e[-1] <- lapply(as.list(e[-1]), subst)
e
}
} else {
eval(e)
}
}
simplify <- function(e) {
if (typeof(e) == "language") {
if (length(all.vars(e))) {
if (length(e) > 1) {
e[-1] <- lapply(as.list(e[-1]), simplify)
e
} else e
} else eval(e)
} else e
}
inverse_bquote <- function(x, SIMPLIFY = TRUE) {
result <- subst(substitute(x))
if (SIMPLIFY) simplify(result) else result
}
Now test it out.
a <- 2
b <- 100
inverse_bquote(2 * a * .(x) + log10(b))
## 4 * x + 2
# without simplification
inverse_bquote(2 * a * .(x) + log10(b), SIMPLIFY = FALSE)
## 2 * 2 * x + log10(100)
Update: Added simplification. Made it optional.
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
}