I am trying to write a function which takes a positive real number and keeps adding terms of the harmonic series until the total sum exceeds the initial argument.
I need my function to display the total number of terms of the series that were added.
Here's my code so far:
harmonic<-function(n){
x<-c(0,1)
while (length(x) < n) {
position <- length(x)
new <- 1/(x[position] + x[position-1])
x <- c(x,new)
}
return(x)
}
I apologise for the errors in my code, unfortunately I have been working with R only for a month and this is the first time that I am using the while loop and I couldn't find any useful information around.
Thank you, I'd really appreciate your help.
Here's an attempt based on some info from this post at maths.stackexchange: https://math.stackexchange.com/q/496116
I can't speak as to whether it is highly accurate in all circumstances or even the best or an appropriate way to go about this. Caveat emptor.
harmsum.cnt <- function(x,tol=1e-09) {
em.cons <- 0.577215664901533
difffun <- function(x,n) x - (log(n) + em.cons + 1/(2*n) - 1/(12*n^2))
ceiling(uniroot(difffun, c(1, 1e10), tol = tol, x = x)$root)
}
Seems to work alright though:
harmsum.cnt(7)
#[1] 616
harmsum.cnt(15)
#[1] 1835421
Compare:
tail(cumsum(1/1:616),1); tail(cumsum(1/1:615),1)
#7.001274
#6.999651
dput(tail(cumsum(1/1:1835421),1)); dput(tail(cumsum(1/1:1835420),1))
#15.0000003782678
#14.9999998334336
This is a partial answer, which I'll try to fill in later. On the assumption that you want an exact answer, rather than the excellent approximation formula thelatemail found, there are a few tools to consider.
First, use of a hash-table or memoise methods will allow you to save previous calculations, thus saving a lot of time.
Second, since the sum of a (finite) sequence is independent of the grouping, you can calculate, e.g. the first N terms and the second (N+1):2N terms independently. Use parallel package to divide and conquer.
Third, before you get too deep into the morass, check the limits of floating-point accuracy via a call to .Machine$double.eps Once your 1/n term comes close to that, you'll need to switch over to gmp and Rmpfr to get full accuracy in your calculations.
Now, just to clarify what you "should" be doing, a correct loop is
mylimit <- [pick a value]
harmsum<-0
for(k in 1:N){
harmsum <- harmsum + 1/k
if (harmsum >= mylimit) break
}
(or similar setup using while)
Related
I run this simple code from class on my R studio desktop(M1 pro MacBook Pro) and the answer is different to the answer I get on R studio cloud. On the MacBook, I get 239.3093 vs 237.7821 on cloud. Am I missing something?
A = matrix(NA,nrow = 50,ncol = 50)
for (i in 1:50) {
for (j in 1:50) {
A[i,j] = sin(i) + cos(j)
}
}
pivot.above = function(A, r, c) {
A[r, ] = A[r, ]/A[r,c]
for (i in (r-1):1) {
A[i, ] = A[i, ]-A[i,c]*A[r, ]
}
A
}
for (i in 0:48) {
j = 50-i
A = pivot.above(A,j,j)
}
A[1, ] = A[1, ]/A[1,1]
print(sum(A))
This matrix has a very large condition number. From Wikipedia:
If the condition number is very large, then the matrix is said to be ill-conditioned. Practically, such a matrix is almost singular, and the computation of its inverse, or solution of a linear system of equations is prone to large numerical errors.
kappa(A)
[1] 1.352794e+19
This means that tiny numerical differences, such as the difference between compilers, system linear algebra libraries, operating systems, chips, etc., will lead to non-negligible differences in the results — as you found out.
As #DaveArmstrong commented, what the OP is doing here is not exactly either of the operations mentioned in the Wikipedia article (inversion or solution of a linear system); we're reducing the matrix to lower triangular form by Gaussian elimination. However, they're closely related (once we've reduced the matrix to triangular form, we've done most of the work of solving a linear system, because we can now use simple back-substitution). I don't know offhand why the sum of the first column of the reduced matrix should be a quantity that is especially sensitive, but it's not surprising to me that the condition number is related to this sensitivity. In these notes, Luke Tierney (an R-core member ...) describes why simple Gaussian elimination is unstable, and why a more sophisticated partial pivoting approach is more stable.
This is a perfectly reasonable question to ask, but is also something you're going to have to learn about/get used to as you move ahead with numerical computation. It would actually be a great thing to ask your instructor about.
Apologies that this isn't really an answer, but perhaps it's somewhere to start. In response to Ben's response to my question, I understand that the algorithm isn't just adding numbers, but so far as I can see, it is just vectorized scalar arithmetic (addition, subtraction, multiplication, division) - there are no matrix operations going on. The fact that the inputs and outputs are organized in a matrix is incidental. Consider what I think is an equivalent set of operations for data organized in a rectangular data frame rather than a square matrix.
B <- expand.grid(
row = 1:50,
col = 1:50)
B <- B %>%
mutate(A = sin(row) + cos(col))
I rewrote the pivot.above function to work for this long-form data:
pivot.above.long <- function(A, rowind, colind){
A$A[which(A$row == rowind)] <- A$A[which(A$row == rowind)]/A$A[which(A$row == rowind & A$col == colind)]
for(i in (rowind - 1):1){
A$A[which(A$row == i)] = A$A[which(A$row == i)]-A$A[which(A$row == i & A$col == colind)]*A$A[which(A$row == rowind)]
}
A
}
Then, I applied that to the long-form data:
for (i in 0:48) {
j = 50-i
B = pivot.above.long(B,j,j)
}
B$A[which(B$row == 1)] <- B$A[which(B$row == 1)]/B$A[which(B$row == 1 & B$col == 1)]
And, I get exactly the same result as I got from the matrix operations - one of the two values returned in the original question.
print(sum(B$A))
# [1] 239.3093
I am trying to minimize an objective function using DEoptim, subject to a simple constraint. I am not clear as to how to add the simple constraint to the call to DEoptim. Here is the objective function:
obj_min <- function(n,in_data) {
gamma <- in_data$Gamma
delta <- in_data$Delta
theta <- in_data$Theta
gammaSum <- sum(n * gamma)
deltaSum <- sum(n * delta)
thetaSum <- sum(n * theta)
abs((EPC * gammaSum - 2 * abs(deltaSum)) / thetaSum )
}
My mapping function (to impose integer constraints) is as follows:
mappingFun <- function(x) {
x[1:length(x)] <- round(x[1:length(x)], 0)
}
My call to DEoptim is:
out <- DEoptim(DTRRR_min, lower = c(rep(-5, length(in_data[, 1]))),
upper = c(rep(5, length(in_data[, 1]))),
fnMap = mappingFun, DEoptim.control(trace = F),in_data)
My in_data object (data frame) is:
Underlying.Price Delta Gamma Theta Vega Rho Implied.Volatility
1 40.69 0.9237 3.2188 -0.7111 2.0493 0.0033 0.3119
2 40.69 0.7713 6.2267 -1.6352 4.3240 0.0032 0.3402
3 40.69 0.5822 8.4631 -2.0019 5.5782 0.0338 0.3229
4 40.69 0.3642 8.5186 -1.8403 5.3661 0.0210 0.3086
5 40.69 0.1802 6.1968 -1.2366 3.7517 0.0093 0.2966
I would like to add a simple constraint that:
sum(n * delta) = target
In other words, the summation of the optimized parameters, n, multiplied by the deltas in my in_data data frame sum to a target of some sort. For simplicity, lets just say 0.5. How do I impose
sum(n * delta) = 0.5
as a constraint? Thank you for your help!
OK, thank you for all of your suggestions. I have researched and worked through my problem from many angles, and I wanted to share my thoughts with everyone, in case they can be helpful to some of you.
Most obvious, in my particular objective function, deltaSum is a variable, and I am attempting to constrain it to a particular value. Simple substitution of this constrained value into the objective function is the solution to this (trivial). However, assuming I was to introduce a constraint on a variable which is not already a variable in the objective function, I can simply run a for loop which returns Inf for any constraint I wish to impose, ie:
obj_func_sum_RRRs <- function(n, in_data) {
#Declare deltaSum, gammaSum, thetaSum, vegaSum, and rhoSum from in_data
#Impose constraints
#No dividing by 0:
if (thetaSum == 0) {
return(Inf)
}
#Specify that regardless of the length of vector of variables to
#be optimized, we only want our final results to include either 4 or 6
#nonzero n's in our final optimized solution
if (!sum(n[1:length(n)] != 0) == 4 &
!sum(n[1:length(n)] != 0) == 6) {
return(Inf)
}
(deltaSum + gammaSum)/thetaSum
}
The first for loop, (thetaSum == 0, return Inf) works because while Inf is a solution which the optimizer understands (and will never select as optimal), division by 0 in R returns NaN, which "breaks" the optimization process. This is a bit "hacky", in that it is likely NOT the most computationally efficient way to approach the problem, but to be honest, with the infrastructure that I am developing with a close friend and software architect guru (which utilizes microservices deployed through the Microsoft Service Fabric), our long-range backtesting is still lightening quick. This methodology actually allows you to impose any number of constraints on your problem, although further testing would need to be done to see how burdensome the computational complexity could become using this technique...
The Lagrange technique above can be viable, but only if you derive an analytical form of lambda on paper, then implement in code. It is not always practical in application, and while you may be able to code up an algorithm to optimize the parameter, it sounds like a bad idea to paint yourself into a corner where you have to optimize a parameter which is, in turn, necessary to the optimizing of the original objective function. Just setting a for loop as advised above seems the better way to go.
Food for thought....
DEOptim package description says
Implements the differential evolution algorithm for global
optimization of a realvalued function of a real-valued parameter
vector.
The concept of global optimization doesn't have place for constraints and it is also known as unconstrained optimization. So sorry but its not possible directly. Having said that you can always use "Lagrange's multiplier" hack if you must do it. To do it you need to do something like:
abs((EPC * gammaSum - 2 * abs(deltaSum))/thetaSum) - lambda* (sum(n * delta) - 0.5)
where you penalizing slack of your constraint.
I am using a wrapper which customises the call of DEoptim based on external constraints. Not very elegant I admit it but it works to some extent.
My objective function - a Monte Carlo simulation - is quite time consuming
so constraints are really helpful...
Chris
Due to the very specific character of what I am doing (Monte Carlo raytracing for the optimisation of neutron beam optics) I did not see any reason to add code. I think it is really the concept what matters here. I'll gladly share what I have with anybody interested. Just let me know.... Chris
I am attempting to use optimize() to find the minimum value of n for the following function (Clopper-Pearson lower bound):
f <- function (n, p=0.5)
(1 + (n - p*n + 1) /
(p*n*qf(p= .025, df1= 2*p, df2= 2*(n - p + 1))))^-1
And here is how I attempted to optimize it:
n_clop <- optimize(f.1, c(300,400), maximum = FALSE, p=0.5)
n_clop
I did this over the interval [300,400] because I suspect the value to be between within it but ultimately I would like to do the optimization between 0 and infinity. It seems that this command is producing a local minimum because no matter the interval it produces the lower bound of that interval as the minimum - which is not what I suspect from clopper-pearson. So, my two questions are how to properly find a global minimum in R and how to so over any interval?
I've very briefly looked over the Wikipedia page you linked and don't see any obvious typos in your formula (although I feel like it should be 0.975=1-alpha/2 rather than 0.025=alpha/2?). However, evaluating the function you've coded over a very broad scale suggests that there are no local minima that are messing you up. My strong guess would be that either your logic is wrong (i.e., n->0 is really the right answer) or that you haven't coded what you think you're coding, due to a typo (possibly in the Wikipedia article, although that seems unlikely) or a thinko.
f <- function (n, p=0.5)
(1 + (n - p*n + 1) /
(p*n*qf(p= .025, df1= 2*p, df2= 2*(n - p + 1))))^-1
Confirm that you're getting the right answer for the interval you chose:
curve(f(x),c(300,400))
Evaluating over a broad range (n=0.00001 to 1000000):
curve(f(10^x),c(-5,7))
As #MrFlick suggests, global optimization is hard. You could start with optim(...method="SANN") but the best answer is definitely case-specific.
Say we have the following statement:
for (i in 1:N) {
pi[i,1] <- ....
pi[i,2] <- ....
pi[i,3] <- ....
...
pi[i,100] <- ...
Y[i] ~ dcat(p[i,])
}
Let's say that Y[1] = 5. Will jags evaluate all the pi[1,1:100] nodes, or the only one needed, i.e. pi[1,5]?
From my experience, it seems that JAGS is inefficiently evaluating all of the parent nodes, because my model was sped up 3x times after I got rid of the dcat. I got to use multiple for loops though for different outcomes of Y[i].
Now I realized that dcat in JAGS actually doesn't require that sum(pi[]) = 1, and that dcat will normalize pi[] so that it sums to 1. This means that it must evaluate all of the nodes.
This is very sad. Is there any smart equivalent of dcat that will only evaluate the only one parent node which is needed? What about WinBUGS and Stan?
Your exampled does not quite have enough detail for me to answer. I have added some expressions on the right hand side:
for (i in 1:N) {
pi[i,1] <- funx(alpha)
pi[i,2] <- funy(alpha)
pi[i,3] <- funz(beta)
...
pi[i,100] <- funw(beta)
Y[i] ~ dcat(p[i,])
}
Suppose we are updating the node alpha, then the sampler that is responsible for updating alpha needs to evaluate funx(alpha) and funy(alpha) but not funz(beta) or funw(beta) (assuming that beta is not a deterministic function of alpha). So in this case pi[i,1] and pi[i,1] are evaluated but not pi[i,3] or pi[i,100]. These other nodes retain their current value.
However, for the likelihood calculations we do have to dereference the current value of all the nodes p[i,1] to p[i,100] to calculate the sum and normalize p. Dereferencing is cheap, but if you do it enough times then it becomes expensive. For example, if you have
for (i in 1:N) {
for (j in 1:M) {
pi[i,j] ~ dexp(1)
}
Y[i] ~ dcat(p[i,])
}
then you have N*M*M dereferencing operations per iteration which can soon add up.
So I guess what you are asking for is a sampler that caches the sum of p[i,] for the likelihood calculations and then updates it based only on the elements that have changed, avoiding the need to dereference the others. That is not available in JAGS, but it might be possible to work towards it in some future versions.
I think you can do what you are asking by just using dbern, i.e.:
for(i in 1:N){
pi[i,1] <- ...
...
pi[i,100] <- ...
Ones[i] ~ dbern(pi[i,Y[i])
}
Where Ones[] is specified in data as an N-length vector of 1.
However, all of pi[] will still be calculated - it has to be because it is a node in your model, and JAGS (or WinBUGS/stan) has no way of telling which nodes you care about and which you don't. You may be able to avoid this by having one value of pi[] for each i and shifting the use of the Y[i] index inside the right hand side of the pi[i] equation - although as Martyn says your example doesn't give enough detail to determine if this is possible.
Matt
Let's say I have a function that is nlogn in space requirements, I want to work out the maximum size of input for that function for a given available space. i.e. I want to find n where nlogn=c.
I followed an approach to calculate n, that looks like this in R:
step = function(R, z) { log(log(R)-z)}
guess = function(R) log(log(R))
inverse_nlogn = function(R, accuracy=1e-10) {
zi_1 = 0
z = guess(R)
while(abs(z - zi_1)>accuracy) {
zi_1 = z
z = step(R, z)
}
exp(exp(z))
}
But I can't get understand why it must be solved iteratively. For the range we are interested (n>1), the function is non singular.
There's nothing special about n log n — nearly all elementary functions fail to have elementary inverses, and so have to be solved by some other means: bisection, Newton's method, Lagrange inversion theorem, series reversion, Lambert W function...
As Gareth hinted the Lambert W function (eg here) gets you almost there, indeed n = c/W(c)
A wee google found this, which might be helpful.
Following up (being completely explicit):
library(emdbook)
n <- 2.5
c <- 2.5*log(2.5)
exp(lambertW(c)) ## 2.5
library(gsl)
exp(lambert_W0(c)) ## 2.5
There are probably minor differences in speed, accuracy, etc. of the two implementations. I haven't tested/benchmarked them extensively. (Now that I tried
library(sos)
findFn("lambert W")
I discover that it's implemented all over the place: the games package, and a whole package that's called LambertW ...