I want to do a conditional cumsum. I originally thought I could use the Reduce function but I wasnt able to. To explain clearly :
a <- rep(1,5)
b <- rnorm(n=5,mean=0.5)
c <- rep(2,5)
d <- rep(0.5,5)
Reduce( '+', a, init=200 , accumulate=TRUE)
Results in
[1] 200 201 202 203 204 205
This is just like a simple cumsum. But what I actually want is a conditional cumsum:
The recursion is defined as :
x0 = 200
index = 0
function (x) {
index = index + 1
if( x is between 200 and 202 ) return x + a[index]
else if(x is between 202 and 204) return x + b[index]
else if(x is between 204 and 206) return x + c[index]
else return x + d[index]
}
The expected result could be something like this (of course it will never be the same because of the randomness.
[1] 200 201 202.3 203.8 204.1 205
For those who are interested, the answer can be found here :
Convert simple recursive relation to functional program
I can't seem to find a way to mark this question as closed since the moderators keep on deleting whatever I add without suggesting a proper way to close.
I don't think you need Reduce here. Here an example that explain a use case of Reduce:
Reduce(paste,list(1:3,letters[1:3],LETTERS[1:3]))
[1] "1 a A" "2 b B" "3 c C"
I think what you try to do xan be done using ifelse, it is vectorized. Here for example a conditional cumultive sum of a and b starting from init value.
a <- rep(1,5)
b <- rep(0.01,5)
init <- 200
x <- seq_along(a)
cumsum(c(init,ifelse( x %% 2 ,a[x], b[x])))
[1] 200.00 201.00 201.01 202.01 202.02 203.02
Of course if you have multiple condition:
Use multiple condition: x %% 2 & x^2 < 5
Use nested ifelse : ifelse( x %% 2 ,ifelse(x^2 <2, a[x], b[x]),1)
Related
How do I retrieve maximum sum of possible divisors numbers
I have a below function which will give possible divisors of number
Code
divisors <- function(x) {
y <- seq_len(ceiling(x / 2))
y[x %% y == 0]
}
Example
Divisors of 99 will give the below possible values.
divisors(99)
[1] 1 3 9 11 33
My expected Logic :
Go from last digit to first digit in the divisors value
The last number is 33, Here next immediate number divisible by 33 is 11 . So I selected 11 , now traversing from 11 the next immediate number divisible by 11 is 1. So selected 1. Now add all the numbers.
33 + 11 + 1 = 45
Move to next number 11, Now next immediate number divisible by 11 is 1. So selected 1. Now add all the numbers.
11 + 1 = 12
Here immediate
Move to next number 9, Now next immediate number divisible by 11 is 1. So selected 1. Now add all the numbers.
9 + 3 + 1 = 13
Move to next number 3, Now next immediate number divisible by 3 is 1. So selected 1. Now add all the numbers.
3+1=4
Now maximum among these is 45.
Now I am struggling to write this logic in R . Help / Advice much appreciated.
Note : Prime numbers can be ignored.
update
For large integers, e.g., the maximum integer .Machine$integer.max (prime number), you can run the code below (note that I modified functions divisors and f a bit)
divisors <- function(x) {
y <- seq(x / 2)
y[as.integer(x) %% y == 0]
}
f <- function(y) {
if (length(y) <= 2) {
return(as.integer(sum(y)))
}
l <- length(y)
h <- y[l]
yy <- y[-l]
h + f(yy[h %% yy == 0])
}
and you will see
> n <- .Machine$integer.max - 1
> x <- divisors(n)
> max(sapply(length(x):2, function(k) f(head(x, k))))
[1] 1569603656
You can define a recursive function f that gives successive divisors
f <- function(y) {
if (length(y) == 1) {
return(y)
}
h <- y[length(y)]
yy <- y[-length(y)]
c(f(yy[h %% yy == 0]), h)
}
and you will see all possible successive divisor tuples
> sapply(rev(seq_along(x)), function(k) f(head(x, k)))
[[1]]
[1] 1 11 33
[[2]]
[1] 1 11
[[3]]
[1] 1 3 9
[[4]]
[1] 1 3
[[5]]
[1] 1
Then, we apply f within sapply like below
> max(sapply(rev(seq_along(x)), function(k) sum(f(head(x, k)))))
[1] 45
which gives the desired output.
You can also use the following solution. It may sound a little bit complicated and of course there is always an easier, more efficient solution. However, I thought this could be useful to you. I will take it from your divisors output:
> x
[1] 1 3 9 11 33
# First I created a list whose first element is our original x and from then on
# I subset the first element till the last element of the list
lst <- lapply(0:(length(x)-1), function(a) x[1:(length(x)-a)])
> lst
[[1]]
[1] 1 3 9 11 33
[[2]]
[1] 1 3 9 11
[[3]]
[1] 1 3 9
[[4]]
[1] 1 3
[[5]]
[1] 1
Then I wrote a custom function in order to implement your conditions and gather your desired output. For this purpose I created a function factory which in fact is a function that creates a function:
As you might have noticed the outermost function does not take any argument. It only sets up an empty vector out to save our desired elements in. It is created in the execution environment of the outermost function to shield it from any changes that might affect it in the global environment
The inner function is the one that takes our vector x so in general we call the whole setup like fnf()(x). First element of of our out vector is in fact the first element of the original x(33). Then I found all divisors of the first element whose quotient were 0. After I fount them I took the second element (11) as the first one was (33) and stored it in our out vector. Then I modified the original x vector and omitted the max value (33) and repeated the same process
Since we were going to repeat the process over again, I thought this might be a good case to use recursion. Recursion is a programming technique that a function actually calls itself from its body or from inside itself. As you might have noticed I used fn inside the function to repeat the process again but each time with one fewer value
This may sound a bit complicated but I believed there may be some good points for you to pick up for future exploration, since I found them very useful, hoped that's the case for you too.
fnf <- function() {
out <- c()
fn <- function(x) {
out <<- c(out, x[1])
z <- x[out[length(out)]%%x == 0]
if(length(z) >= 2) {
out[length(out) + 1] <<- z[2]
} else {
return(out)
}
x <- x[!duplicated(x)][which(x[!duplicated(x)] == z[2]):length(x[!duplicated(x)])]
fn(x)
out[!duplicated(out)]
}
}
# The result of applying the custom function on `lst` would result in your
# divisor values
lapply(lst, function(x) fnf()(sort(x, decreasing = TRUE)))
[[1]]
[1] 33 11 1
[[2]]
[1] 11 1
[[3]]
[1] 9 3 1
[[4]]
[1] 3 1
[[5]]
[1] 1
In the end we sum each element and extract the max value
Reduce(max, lapply(lst, function(x) sum(fnf()(sort(x, decreasing = TRUE)))))
[1] 45
Testing a very large integer number, I used dear #ThomasIsCoding's modified divisors function:
divisors <- function(x) {
y <- seq(x / 2)
y[as.integer(x) %% y == 0]
}
x <- divisors(.Machine$integer.max - 1)
lst <- lapply(0:(length(x)-1), function(a) x[1:(length(x)-a)])
Reduce(max, lapply(lst, function(x) sum(fnf()(sort(x, decreasing = TRUE)))))
[1] 1569603656
You'll need to recurse. If I understand correctly, this should do what you want:
fact <- function(x) {
x <- as.integer(x)
div <- seq_len(abs(x)/2)
factors <- div[x %% div == 0L]
return(factors)
}
maxfact <- function(x) {
factors <- fact(x)
if (length(factors) < 3L) {
return(sum(factors))
} else {
return(max(factors + mapply(maxfact, factors)))
}
}
maxfact(99)
[1] 45
I am a new R user and have very limited programming experience, hence my question and poorly written code.
I was assigned a problem where I had to use a while loop to generate the numbers of the Fibonacci sequence that are less than 4,000,000 (the Fibonacci sequence is characterized by the fact that every number after the first two is the sum of the two preceding ones).
Next, I had to compute the sum of the even numbers in the sequence that was generated.
I was successful with my response, however, I don't think the code is written very well. What could I have done better?
> x <- 0
> y <- 1
> z <- 0
if (x == 0 & y == 1) {
cat(x)
cat(" ")
cat(y)
cat(" ")
while (x < 4000000 & y < 4000000) {
x <- x + y
cat(x)
cat(" ")
if (x %% 2 == 0) {
z <- x + z
}
y <- x + y
cat(y)
cat(" ")
if (y %% 2 == 0) {
z <- y + z
}
}
}
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578 5702887 9227465
cat(z)
4613732
First of all, cat comes with a sep argument. You can do cat(x, y, sep = " ") rather than using 3 lines for that.
Secondly, when you call while (x < 4000000 & y < 4000000) note that y will always be greater than x because it is the sum of the last x and y ... so it should suffice to check for y < 4000000 here.
For the while loop, you could also use a counter - might be more intuitive. Indexing in R isn't that fast though
fib <- c(0, 1)
i <- 2
while (fib[i] < 4000000) {
fib <- c(fib, fib[i-1] + fib[i])
i <- i + 1
}
sum(fib[fib %% 2 == 0])
If you don't necessarily need the while, you could also approach it via recursion
fib <- function(x, y) {
s <- x + y
c(s, if (s < 4000000) fib(y, s))
}
f <- fib(0, 1)
sum(f[f %% 2 == 0])
First, there's no need o explicitly print everything out.
Second, it's more idiomatic in R to make a vector of the Fibonacci numbers and then sum. If you don't know an explicit closed form for the Fibonacci numbers, or if you've been told not to use this, then use a loop to create the list of Fibonacci numbers.
So to construct the list of Fibonacci numbers (two at a time) you can do
x <- 0
y <- 1
fib <- c()
while (x < 4000000 & y < 4000000){
x <- x + y
y <- x + y
fib = c(fib, x, y)
}
This will give you a vector of Fibonacci numbers, containing all those less than 4000000 and a few more (the last element is 9227465).
Then run
sum(fib[fib %% 2 == 0 & fib < 4000000])
to get the result. This returns 4613732, like your code does. The subsetting operator [], when you put a logical condition inside it, will output just those numbers which satisfy the logical condition -- in this case, that they're even and less than 4000000.
I am using the closed form of the fibonacci sequence as found here
fib = function(n) round(((5 + sqrt(5)) / 10) * (( 1 + sqrt(5)) / 2) ** (1:n - 1))
numbers <- 2
while (max(fib(numbers)) < 4000000){ # try amount of numbers while the maximum of the sequence is less than 4000000
sequence <- fib(numbers) # here the sequence that satisfies the "4000000 condition will be saved"
numbers <- numbers + 1 # increase the amount of numbers
}
total_sum <- sum(sequence[sequence%%2==0]) # summing the even numbers
This is how I would do it. First, I defined a global variable i to include the first two elements of the Fibonacci series. Then at the end, I re-assigned the global variable to its initial value (i.e. 1). If I don't do that, then when I call the function fib(0,1) again, the output is incorrect as it calls the function with the last value of i. It's also important to do return() to ensure it doesn't return anything in the else clause. If you don't specify return(), the final output will be 1, instead of the Fibonacci series.
Please note the series only goes till the number 13 (z<14) obviously you can change that to whatever you want. May also be a good option to include this as the third argument of the function, something like fib(0,1,14). Try it out!
i <<- 1
fib <- function(x,y){
z <- x+y
if(z<14){
if (i==1){
i <<- i+1
c(x,y,z,fib(y,z))
}
else c(z, fib(y,z))
}
else {
i <<- 1
return()
}
}
a <- fib(0,1)
a
I am looking for an efficient way to nest the same function in R until a condition is met. I hope the following example illustrates my problem clearly.
Consider the function
f(x) = x^2 + 1, with x > 1.
Denote
f^{(k)}(x) = f(f(f(...f(x)))),
where the function f is evaluated k times within itself. Let M > 0, with M given.
Is there any efficient routine in R to determine the minimum value of k such that f^{(k)}(2) > M?
Thank you.
Nothing special for that. Just use a loop:
function(x, M) {
k <- 0
repeat {
x <- x^2 + 1
k <- k + 1
if (x > M)
break
}
k
}
Not particularly efficient, but often the overhead of evaluating f will be greater than the overhead of the loop. If that's not the case (and it might not be for this particular f), I'd suggest doing the equivalent thing in C or C++ (perhaps using Rcpp).
This would be the recursive approach:
# 2^2 + 1 == 5
# 5^2 + 1 == 26
# 26^2 + 1 == 677
f <- function(x,M,k=0){
if(x <= M) k <- f(x^2 + 1,M=M,k+1)
return(k)
}
f(2,3) # 1
f(2,10) # 2
f(2,50) # 3
f(2,700) # 4
I am trying to understand a function in R. could you please declare some part of it for me:
the function is:
subsignals <- lapply(c(peakind$freqindex, midindex+1), function(x){
upperind <- x
fsub <- f
notnullind <- ((fsub$freqindex >= lowerind
& fsub$freqindex < upperind)
|
(fsub$freqindex > (lindex - upperind + 2)
& fsub$freqindex <= (lindex - lowerind + 2)))
fsub[!notnullind,"coef"] <- 0
lowerind <<- upperind
Re(fft(fsub$coef, inverse=TRUE)/length(fsub$coef))
})
Could some one explain me:
1-What could be the content of notnullind and generally, what does this part of code do:
notnullind <- ((fsub$freqindex >= lowerind
& fsub$freqindex < upperind)
|
(fsub$freqindex > (lindex - upperind + 2)
& fsub$freqindex <= (lindex - lowerind + 2)))
2-What does fsub[!notnullind,"coef"] <- 0 mean?
3-What does<<- in lowerind <<- upperind mean?
further information:
peakind looks like this:
coef freqindex
9 2.714391+3.327237i 9
17 1.273340+4.023808i 17
25 -0.445424+5.674848i 25
33 -1.378107+3.182281i 33
41 -2.798383+2.340895i 41
49 -4.479888+1.095193i 49
and fsub :
coef freqindex
1 19.2352397+0.0000000i 1
2 -0.4799684+0.1651822i 2
3 1.5235726+0.0790459i 3
4 -0.1165587+0.1217513i 4
5 2.2376900+1.6763410i 5
6 1.1256711+0.4624819i 6
.....
102 -0.1165587-0.1217513i 102
103 1.5235726-0.0790459i 103
104 -0.4799684-0.1651822i 104
It seems that the code is iterating through fsub in chunks defined by the difference between adjacent entries in peakind. Presumably peakind contains interesting points in fsub. You can see this because most of the fsub comparison are between x (which comes from peakind), and lowerind, which is set to be the prior loops x/upperind value.
notnullind will be a logical vector (TRUE, FALSE) that is TRUE for the rows in fsub that are between this iterations peakind$freqindex and the prior ones as well as something else based on lindex that I can't tell you b/c that variable is undefined in your code.
That line is setting all the values in fsub$coef that don't meet the condition described above to zero
lowerind<<-upperind is a global assignment outside of the function being run through lapply. This allows the function run by lapply to keep track of the last upperind from a previous call to that same function in lapply loop. The assignment must be global as otherwise the value would be lost after every iteration in lapply.
Basically, the function is doing an fft for the data between in fsub between adjacent pairs of index values defined in peakind.
Note that 3. suggests your function isn't structured in the best possible manner. You should generally avoid global assignments unless you really can't. In this case, I would loop through the rows of cbind(head(peakind$freqindex, -1L), tail(peakind$freqindex, -1L)) which contains the range of indices you care about for each iteration.
Why can we use ifelse() but not else if(){} in with() or within() statement ?
I heard the first is vectorizable and not the latter. What does it mean ?
The if construct only considers the first component when a vector is passed to it, (and gives a warning)
if(sample(100,10)>50)
print("first component greater 50")
else
print("first component less/equal 50")
The ifelse function performs the check on each component and returns a vector
ifelse(sample(100,10)>50, "greater 50", "less/equal 50")
The ifelse function is useful for transform, for instance. It is often useful to
use & or | in ifelse conditions and && or || in if.
Answer for your second part:
*Using if when x has length of 1 but that of y is greater than 1 *
x <- 4
y <- c(8, 10, 12, 3, 17)
if (x < y) x else y
[1] 8 10 12 3 17
Warning message:
In if (x < y) x else y :
the condition has length > 1 and only the first element will be used
Usingifelse when x has length of 1 but that of y is greater than 1
ifelse (x < y,x,y)
[1] 4 4 4 3 4