How to create my own binomial coefficient function in R - 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

Related

Integration of a function with while loop in R

I want to integrate a function involving while loop in R. I have pasted here an MWE. Could anyone please guide about how to get rid of warning messages when integrating such a function?
Thank You
myfun <- function(X, a, b, kmin, kmax){
term <- 0
k <- 1
while(k < kmax | term < 10000){
term <- term + a * b * X^k
k <- k+1
}
fx <- exp(X) * term
return(fx)
}
a <- 5
b <- 4
kmax <- 20
integrate(myfun, lower = 0, upper = 10, a = a, b = b, kmax = kmax)
Produces a warning, accessed via warnings():
In while (k < kmax | term < 10000) { ... :
the condition has length > 1 and only the first element will be used
From the integrate() documentation:
f must accept a vector of inputs and produce a vector of function evaluations at those points.
This is the crux of the problem here, which you can see by running myfun(c(1, 2), a, b, kmin, kmax) and reproducing a similar warning. What's happening is that integrate() wants to pass a vector of inputs to myfun in X; this means that inside your while loop, term will become a vector as well. This creates a problem when the while loop kicks back to the evaluation stage, because now the condition k < kmax | term < 10000 has a vector structure as well (since term does), which while doesn't like.
This warning is very good in this case, because it strongly suggests that integrate() isn't doing what you want it to do. Your goal here isn't to get rid of the warning messages; the function as written simply won't work with integrate() due to the while loop structure.
Your choices for how to proceed are to either (1) rewrite the function in a way that doesn't use a while loop, or (2) just hard-code some numeric integration yourself, perhaps with a for loop. The best way to use R is to vectorize everything and to avoid things like while and for when at all possible.
Finally, I'll note that there seems to be some problem with the underlying function, since myfun(0.5, a, b, kmin, kmax) does not converge (note the problem with the mathematics when the supplied X term is less than 1), so you won't be able to integrate it on the interval [0, 10] no matter what you do.

Solve non-linear equations using "nleqslv" package

I tried to solve the these non-linear equations by using nleqslv. However it does not work well. I do know the reason why it does not because I didn't separate the two unknowns to different sides of the equation.
My questions are: 1, Are there any other packages that could solve this kind of
equations?
2, Is there any effective way in R that could help me rearrange
the equation so that it meets the requirement of the package
nleqslv?
Thank you guys.
Here are the codes and p[1] and p[2] are the two unknowns I want to solve.
dslnex<-function(p){
p<-numeric(2)
0.015=sum(exp(Calib2$Median_Score*p[1]+p[2])*weight_pd_bad)
cum_dr<-0
for (i in 1:length(label)){
cum_dr[i]<-exp(Calib2$Median_Score*p[1]+p[2][1:i]*weight_pd_bad[1:i]/0.015
}
mid<-0
for (i in 1:length(label)){
mid[i]<-sum(cum_dr[1:i])/2
}
0.4=(sum(mid*weight_pd_bad)-0.5)/(0.5*(1-0.015))
}
pstart<-c(-0.000679354,-4.203065891)
z<- nleqslv(pstart, dslnex, jacobian=TRUE,control=list(btol=.01))
Following up on my comment I have rewritten your function as follows correcting errors and inefficiencies.
Errors and other changes are given as inline comments.
# no need to use dslnex as name for your function
# dslnex <- function(p){
# any valid name will do
f <- function(p) {
# do not do this
# you are overwriting p as passed by nleqslv
# p<-numeric(2)
# declare retun vector
y <- numeric(2)
y[1] <- 0.015 - (sum(exp(Calib2$Median_Score*p[1]+p[2])*weight_pd_bad))
# do not do this
# cum_dr is initialized as a scalar and will be made into a vector
# which will be grown as a new element is inserted (can be very inefficient)
# cum_dr<-0
# so declare cum_dr to be a vector with length(label) elements
cum_dr <- numeric(length(label))
for (i in 1:length(label)){
cum_dr[i]<-exp(Calib2$Median_Score*p[1]+p[2][1:i]*weight_pd_bad[1:i]/0.015
}
# same problem as above
# mid<-0
mid <- numeric(length(label))
for (i in 1:length(label)){
mid[i]<-sum(cum_dr[1:i])/2
}
y[2] <- 0.4 - (sum(mid*weight_pd_bad)-0.5)/(0.5*(1-0.015))
# return vector y
y
}
pstart <-c(-0.000679354,-4.203065891)
z <- nleqslv(pstart, dslnex, jacobian=TRUE,control=list(btol=.01))
nleqslv is intended for solving systems of equations of the form f(x) = 0 which must be square.
So a function must return a vector with the same size as the x-vector.
You should now be able to proceed provided your system of equations has a solution. And provided there are no further errors in your equations. I have my doubles about the [1:i] in the expression for cum_dr and the expression for mid[i]. The loop calculating mid possibly can be written as a single statement: mid <- cumsum(cum_dr)/2. Up to you.

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

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.

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

Optimizing a function in a loop

I am trying to deal with a likelihood function from an AR(2) model.
I have to maximize a function with respect to two variables, alpha1 and alpha2.
Since it is about time series, I have the variable x stored in a matrix for 200 time periods.
I have 10000 simulations of this. So I have the x values in a 200x10000 matrix.
I want to directly have a matrix of 2x10000 in which the results of the optimization for every simulation are stored. I have set a for loop and I have specified the function inside of it, but it is not working, i.e. when I run it it tells me:
Error in A <- -optim(c(1.5, 0.75), log_lik) : argument not valid for operator
I attach here my code. I have created a function to contain the results before running the loop and I have called it A:
for (i in 1:R) {
for (t in 3:N) {
log_lik <- function (α) {
α1 <- α[1]
α2 <- α[2]
L = -1/2*((N-2)*log(pi*2)+(N-2)*log(1)+sum((x[t,i]-c-α1*x[t-1,i]-α2*x[t-2,i])^2))
}
A <- -optim(c(1.5, 0.75), log_lik)$par
}
return(A)
}
Thanks a lot!!

Resources