Use lapply for a recursion (so without a foor loop) - r

I'd like to solve a recursion function in R, which is defined as
p(t) = 0.5p(t-1) + 0.2p(t-2)
for t = 3,...,100, where the initial values p(1), p(2) are given.
I know that this would be possible to solve using a for loop just like this one here: Using R to solve a recursion function
I'm wondering whether this is also possible using the lapply() function in R? I think it should somehow be possible, but I don't know where to start. I'd appreciate any hint.

Sure you can use recursive function with lapply.
p <- function(t){
if(t == 1){ return(1) } # arbitrary number
if(t == 2){ return(2) } # arbitrary number
return( 0.5*p(t-1) + 0.2*p(t-2) )
}
lapply(3:100, p)
Note that it is a bad idea to use a recursive function for this problem without some sort of memoization, because it will be of exponential complexity.
The following code works in linear time instead:
p_tab <- c(1, 2, rep(-1, 98)) # 1 and 2 arbitrary numbers
p <- function(t){
if(p_tab[t] != -1) return(p_tab[t])
p_tab[t] <<- 0.5*p_tab[t-1] + 0.2*p_tab[t-2]
}
p_tab <- unlist(lapply( 1:100, p))
p_tab will be filled with the numbers you need. p_tab[100] will be p(100) for instance, if that's the one you need.

Related

How to create my own binomial coefficient function in R

I have created a factorial function which is then used to create a function for the binomial coefficient. My factorial function works but the binomial function does not.
I needed to create a factorial function which was then to be used to create a binomial coefficient function using R.
I was not allowed to use the base program's functions such as factorial nor choose.
I had to use for statements, logics etc. even though it is inefficient.
I had to print the factorial of zero and ten, then the binomial coefficient with n = 5, and k = 2
fact <- function(n) {
x <- 1
if(n == 0) {
print(1)
} else {
for(i in 1:n) {
x <- x*i
}
}
print(x)
}
fact(0)
fact(10)
bc <- function(n, k) {
y <- fact(n) / fact(n - k) * fact(k)
print(y)
}
bc(5, 2)
For the factorial function I got the correct answer
But for the binomial function I was way off.
If someone can show me where I have made the mistake I would be most appreciative.
There are quite a few issues here, both relating to basic R coding and coding in general. Let's go through some of them step-by-step:
Your function fact actually does not return anything. All it does at the moment is print values to the console. If you take a look at help("print") it is stated that
‘print’ prints its argument and returns it invisibly (via ‘invisible(x)’).
So in order for fact to actually return a value we can do
fact <- function(n) {
x <- 1
if (n > 0) {
for (i in 1:n) x <- x * i
}
return(x)
}
I have tidied up your code by removing the unnecessary n == 0 check.
Note that there is still room for improvement. For example, there are better ways to calculate the factorial of a number. Secondly, your function currently does not properly deal with negative numbers. Generally, the factorial is only defined for non-negative integers. So you can either change fact to return NA for negative numbers, or -- perhaps more interesting -- generalise the factorial function to the Gamma function to allow for any real (or even complex) number. Either way, I'll leave this up to you.
Similarly your function bc also does not return anything, and instead writes the value of y to the console. Furthermore you need to be careful of brackets to make sure that the terms (n - k)! and k! are in the denominator. Both issues can be fixed by writing
bc <- function(n,k) return(fact(n)/(fact(n - k) * fact(k)))
To confirm, we calculate the coefficient for 5 choose 2:
bc(5, 2)
#10

How to avoid coding first iteration outside while loop

I frequently have problems that lend themselves to while loops, but come out ugly, and I'm here to ask if there is an elegant solution or if all possible solutions are ugly. Is there?
Here's a simplified example: suppose we are trying to find the minimum value of a function f <- function(x){x^2}, as well as the location at which it is found. Suppose we elect to find the minimum by making an initial guess x and evaluating f(x). Then we evaluate f(x-0.1), and f(x+0.1). If either of these values is lower than f(x), our new guess is the argmin. We repeat until such shifts no longer decrease the value.
The best solution I have come up with is to run part of the first iteration of the algorithm outside of the loop. But this requires me to duplicate code from the loop, namely the section of code enclosed with !!!!!!!.
# function to minimize
f <- function(x){x^2}
# initial guess
x.current <- 1
f.current <- f(x.current)
# !!!!!!!!!!!!
# part of first iteration
x.guess <- c(x.current - 0.1, x.current + 0.1)
f.guess <- sapply(x.guess, f)
best.ind <- which.min(f.guess)
x.new <- x.guess[best.ind]
f.new <- f.guess[best.ind]
# !!!!!!!!!!!!
# part of first iteration and later iterations
while (f.new < f.current){
x.current <- x.new
f.current <- f.new
x.guess <- c(x.current - 0.1, x.current + 0.1)
f.guess <- sapply(x.guess, f)
best.ind <- which.min(f.guess)
x.new <- x.guess[best.ind]
f.new <- f.guess[best.ind]
}
print("best guess = ")
print(x.current)
Is there a "nicer" way of doing this?
There are a variety of ways to deal with this situation. Whether one is 'ugly' or 'pretty' is a matter of opinion, and therefore off topic for StackOverflow. Nonetheless, we can make some generalisations about some different options:
Option 1: wrap repetitive lines in their own function
A common rule of thumb is that one should avoid repeating code segments. Whenever you see a sequence of lines repeated at various places in your program, one should strongly consider placing those lines into their own function and calling this function repeatedly.
This aids in the readability of the overall code by making it more succinct, and requiring a maintainer to only read through and understand that section once.
Perhaps more importantly, it also aids in maintainability of the code because any changes to that snippet will automatically propagate through the whole program. Having to hunt down and alter every instance of a repeated code snippet is not only frustrating when it comes to editing code, but it is also a potentially error-prone procedure.
Here's one way you might apply this principle here, using an additional trick of placing the function call inside the loop condition expression, so that we only need to call it once here (although the code inside a while loop is not guaranteeed to execute, the code in its condition must always be executed at least once:
# initial guess
x <- 1
fx <- f(x)
find.new = function(x){
x.new <- c(x - 0.1, x + 0.1)
f.new <- sapply(x.new, f)
best.ind <- which.min(f.new)
x.new <- x.new[best.ind]
f.new <- f.new[best.ind]
return(list(x=x.new, fx=f.new))
}
while ((new <- find.new(x))$fx < fx){
x <- new$x
fx <- new$fx
}
2 use a repeat loop instead
If, as in this case, there is some code inside the loop that we would always want to execute at least onse, then consider using a repeat loop instead of while. We can then test for the exit condition to either update values or to break from the loop. If the repeated code snippet in your original does not need to execute anywhere else in your program, this can be more concise than wrapping it in its own function
repeat {
x.new <- c(x - 0.1, x + 0.1)
f.new <- sapply(x.new, f)
best.ind <- which.min(f.new)
x.new <- x.new[best.ind]
f.new <- f.new[best.ind]
if (f.new < fx) {
x <- x.new
fx <- f.new
} else {
break
}
}
As pointed out by dww there are several options. There is a third one which initializes the variables which are referenced in the first iteration of the loop and in the test condition of the loop appropriately:
# function to minimize
f <- function(x){x^2}
# initialize values
x.new <- 1
f.new <- f(x.new)
f.current <- f.new + 0.1 # just to fulfill test condition
# part of first iteration and later iterations
while (f.new < f.current){
x.current <- x.new
f.current <- f.new
x.guess <- c(x.current - 0.1, x.current + 0.1)
f.guess <- sapply(x.guess, f)
best.ind <- which.min(f.guess)
x.new <- x.guess[best.ind]
f.new <- f.guess[best.ind]
}
print("best guess = ")
print(x.current)

Exponential distribution in R

I want to simulate some data from an exp(1) distribution but they have to be > 0.5 .so i used a while loop ,but it does not seem to work as i would like to .Thanks in advance for your responses !
x1<-c()
w<-rexp(1)
while (length(x1) < 100) {
if (w > 0.5) {
x1<- w }
else {
w<-rexp(1)
}
}
1) The code in the question has these problems:
we need a new random variable on each iteration but it only generates new random variables if the if condition is FALSE
x1 is repeatedly overwritten rather than extended
although while could be used repeat seems better since having the test at the end is a better fit than the test at the beginning
We can fix this up like this:
x1 <- c()
repeat {
w <- rexp(1)
if (w > 0.5) {
x1 <- c(x1, w)
if (length(x1) == 100) break
}
}
1a) A variation would be the following. Note that an if whose condition is FALSE evaluates to NULL if there is no else leg so if the condition is FALSE on the line marked ## then nothing is concatenated to x1.
x1 <- c()
repeat {
w <- rexp(1)
x1 <- c(x1, if (w > 0.5) w) ##
if (length(x1) == 100) break
}
2) Alternately, this generates 200 exponential random variables keeping only those greater than 0.5. If fewer than 100 are generated then repeat. At the end it takes the first 100 from the last batch generated. We have chosen 200 to be sufficiently large that on most runs only one iteration of the loop will be needed.
repeat {
r <- rexp(200)
r <- r[r > 0.5]
if (length(r) >= 100) break
}
r <- head(r, 100)
Alternative (2) is actually faster than (1) or (1a) because it is more highly vectorized. This is despite it throwing away more exponential random variables than the other solutions.
I would advise against a while (or any other accept/reject) loop; instead use the methods from truncdist:
# Sample 1000 observations from a truncated exponential
library(truncdist);
x <- rtrunc(1000, spec = "exp", a = 0.5);
# Plot
library(ggplot2);
ggplot(data.frame(x = x), aes(x)) + geom_histogram(bins = 50) + xlim(0, 10);
It's also fairly straightforward to implement a sampler using inverse transform sampling to draw samples from a truncated exponential distribution that avoids rejecting samples in a loop. This will be a more efficient method than any accept/reject-based sampling method, and works particularly well in your case, since there exists a closed form of the truncated exponential cdf.
See for example this post for more details.

Returning 'traditional' notations of functions in the context of fourier interpolation

in numerical analysis we students are obligated to implement code in R that given a function f(x) finds its Fourier interpolation tN(x) and computes the interpolation error
$||f(x)-t_{N}(x)||=\int_{0}^{2\pi}$ $|f(x)-t_{N}(x)|^2$
or a variety of different $N$
I first tried to compute the d-coefficients according to this formular:
$d = \frac 1N M y$
with M denoting the DFT matrix and y denoting a series of equidistant function values with
$y_j = f(x_j)$ and
$x_j = e^{\frac{2*pi*i}N*j}$
for $j = 1,..,N-1$.
My goal was to come up with a sum that can be described by:
$t_{N}(x) = \Sigma_{k=0}^{N-1} d_k * e^{i*k*x}$
Which would be easier to later integrate in sort of a subsequently additive notation.
f <- function(x) 3/(6+4*cos(x)) #first function to compare with
g <- function(x) sin(32*x) #second one
xj <- function(x,n) 2*pi*x/n
M <- function(n){
w = exp(-2*pi*1i/n)
m = outer(0:(n-1),0:(n-1))
return(w^m)
}
y <- function(n){
f(xj(0:(n-1),n))
}
transformFunction <- function(n, f){
d = 1/n * t(M(n)) %*% f(xj(0:(n-1),n))
script <- paste(d[1])
for(i in 2:n)
script <- paste0(script,paste0("+",d[i],"*exp(1i*x*",i,")"))
#trans <- sum(d[1:n] * exp(1i*x*(0:(n-1))))
return(script)
}
The main purpose of the transform function was, initially, to return a function - or rather: a mathematical expression - which could then be used in order to declarate my Fourier Interpolation Function. Problem is, based on my fairly limited knowledge, that I cannot integrate functions that still have sums nested in them (which is why I commented the corresponding line in the code).
Out of absolute desperation I then tried to paste each of the summands in form of text subsequently, only to parse them again as an expression.
So the main question that remains is: how do I return mathmatical expressions in a manner that allow me to use them as a function and later on integrate them?
I am sincerely sorry for any misunderstanding or confusion, as well as my seemingly amateurish coding.
Thanks in advance!
A function in R can return any class, so specifically also objects of class function. Hence, you can make trans a function of x and return that.
Since the integrate function requires a vectorized function, we use Vectorize before outputting.
transformFunction <- function(n, f){
d = 1/n * t(M(n)) %*% f(xj(0:(n-1),n))
## Output function
trans <- function(x) sum(d[1:n] * exp(1i*x*(0:(n-1))))
## Vectorize output for the integrate function
Vectorize(trans)
}
To integrate, now simply make a new variable with the output of transformFunction:
myint <- transformFunction(n = 10,f = f)
Test: (integrate can only handle real-valued functions)
integrate(function(x) Re(myint(x)),0,2)$value +
1i*integrate(function(x) Im(myint(x)),0,2)$value
# [1] 1.091337-0.271636i

Recursion function in R

Here is the code, that calculate the binomial coefficient:
binomial_coef <- function(n,r){
if (n == r | r == 0){
return(1)
}
else{
result <- binomial_coef(n-1,r-1) + binomial_coef(n-1,r)
return(result)
}
}
Can you please explain how this code works? How can it calculate, when the function(binomial_coef) isn't define(I mean, there is no formula inside the code)
Thanks
The function(binomial_coef) is indeed defined. This is another way of solving nCr.
nCr= n-1Cr-1 + n-1Cr
So the required nCr gets calculated according to this formula recursively.

Resources