I have this recursive function and I am trying to find the result when x(n) = 1000.
x <- function (n) if (n==1) 1 else {(13*Recall(n - 1) + 7) %% 112233}
I can use this code when n < 600 or something but when n > 600 I get
"evaluation nested too deeply:
infinite recursion / options(expressions=)?".
How should I change the code to calculate x(1000)?
AFAIK GNU-R uses c's call stack, so it's not that well suited for lengthy recursions. You'd probably get better with iterative version:
x2 <- function(n) {
acc <- 1;
m <- 1;
repeat {
acc <- (13*acc+7) %% 112233
m <- m+1
if (m>=n) break
}
acc
}
e.g.
> x2(600)
[1] 67812
> x2(1000)
[1] 9292
Related
I'm trying to solve the problem #14 of Project Euler.
So the main objective is finding length of Collatz sequence.
Firstly I solved problem with regular loop:
compute <- function(n) {
result <- 0
max_chain <- 0
hashmap <- 1
for (i in 1:n) {
chain <- 1
number <- i
while (number > 1) {
if (!is.na(hashmap[number])) {
chain <- chain + hashmap[number]
break
}
if (number %% 2 == 0) {
chain <- chain + 1
number <- number / 2
} else {
chain <- chain + 2
number <- (3 * number + 1) / 2
}
}
hashmap[i] <- chain
if (chain > max_chain) {
max_chain <- chain
result <- i
}
}
return(result)
}
Only 2 seconds for n = 1000000.
I decided to replace while loop to recursion
len_collatz_chain <- function(n, hashmap) {
get_len <- function(n) {
if (is.na(hashmap[n])) {
hashmap[n] <<- ifelse(n %% 2 == 0, 1 + get_len(n / 2), 2 + get_len((3 * n + 1) / 2))
}
return(hashmap[n])
}
get_len(n)
return(hashmap)
}
compute <- function(n) {
result <- 0
max_chain <- 0
hashmap <- 1
for (i in 1:n) {
hashmap <- len_collatz_chain(i, hashmap)
print(length(hashmap))
if (hashmap[i] > max_chain) {
max_chain <- hashmap[i]
result <- i
}
}
return(result)
}
This solution works but works so slow. Almost 1 min for n = 10000.
I suppose that one of the reasons is R creates hashmap object each time when call function len_collatz_chain.
I know about Rcpp packages and yes, the first solution works fine but I can't understand where I'm wrong.
Any tips?
For example, my Python recursive solution works in 1 second with n = 1000000
def len_collatz_chain(n: int, hashmap: dict) -> int:
if n not in hashmap:
hashmap[n] = 1 + len_collatz_chain(n // 2, hashmap) if n % 2 == 0 else 2 + len_collatz_chain((3 * n + 1) // 2, hashmap)
return hashmap[n]
def compute(n: int) -> int:
result, max_chain, hashmap = 0, 0, {1: 1}
for i in range(2, n):
chain = len_collatz_chain(i, hashmap)
if chain > max_chain:
result, max_chain = i, chain
return result
The main difference between your R and Python code is that in R you use a vector for the hashmap, while in Python you use a dictionary and that hashmap is transferred many times as function argument.
In Python, if you have a Dictionary as function argument, only a reference to the actual data is transfered to the called function. This is fast. The called function works on the same data as the caller.
In R, a vector is copied when used as function argument. This is potentially slow, but safer in the sense that the called function cannot alter the data of the caller.
This the main reason that Python is so much faster in your code.
You can however alter the R code slightly, such that the hashmap is not transfered as function argument anymore:
len_collatz_chain <- local({
hashmap <- 1L
get_len <- function(n) {
if (is.na(hashmap[n])) {
hashmap[n] <<- ifelse(n %% 2 == 0, 1 + get_len(n / 2), 2 + get_len((3 * n + 1) / 2))
}
hashmap[n]
}
get_len
})
compute <- function(n) {
result <- rep(NA_integer_, n)
for (i in seq_len(n)) {
result[i] <- len_collatz_chain(i)
}
result
}
compute(n=10000)
This makes the R code much faster. (Python will probably still be faster though).
Note that I have also removed the return statements in the R code, as they are not needed and add one level to the call stack.
I want to create an script that calculates probabilities for a rol game.
I´m new to programming and I´m stuck with the return values and nested functions. What I want is to use the values returned by the first function in the next one.
I have two functions dice(k, n) and fight(a, b). (for the example, the functions are partly written):
dice <- function (k, n) {
if (k > 3 && n > 2){
a <- 3
b <- 2
attack <- sample(1:6, a)
deff <- sample(1:6, b)
}
return(c(attack, deff))
}
So I want to use the vector attack, and deff in the next function:
fight <- function(a, b){
if (a == 3 && b == 2){
if(sort(attack,T)[1] > sort(deff,T)[1]){
n <- n - 1}
if (sort(attack,T)[1] <= sort(deff,T)[1]) {
k <- k - 1}
if (sort(attack,T)[2] > sort(deff,T)[2]) {
n <- n - 1}
if (sort(attack,T)[2]<= sort(deff,T)[2]){
k <- k - 1}
}
return(c(k, n)
}
But this gives me the next error:
Error in sort(attack, T) : object 'attack' not found
Any ideas? Thanks!
I try to write a recursive function that returns the sum of digits. However, the program below doesn't seem to do the trick.
getSum = function(i) {
if (i < 0) {Print("Please enter a positive number")}
if (i >= 0) {getSum(i - floor(i / 10) - i %% 10) + floor(i / 10) + i %% 10}
It gives two errors:
Error: evaluation nested too deeply: infinite recursion / options(expressions=)?
Error during wrapup: evaluation nested too deeply: infinite recursion /
options(expressions=)?
What can I do to solve this?
Use this
if (i >= 0)
{sum(sapply(strsplit(as.character(i),""),as.numeric))}
Of course this works for whole numbers. If your need is greater more regex can be added to accommodate that
Edited! Oops totally missed that you want a recursive function
Do you want something like this?
getSum = function(i){
i = abs(floor(i))
if (nchar(i) == 1){
return(i)
} else {
getSum(floor(i/10)) +i%%10 #Minorpt (suggested by #DashingQuark)
}
}
In R, it is recommended to use Recall for creating a recursive function.
I am using #d.b's function, but demonstrating with Recall
getSum = function( i )
{
if (nchar(i) == 1){
return(i)
} else if (i < 0 ) {
"Please enter a positive number"
}else {
print(i)
Recall( i = floor(i/10)) +i%%10
}
}
getSum(0)
# [1] 0
getSum(1)
# [1] 1
getSum(-1)
# [1] "Please enter a positive number"
getSum(5)
# [1] 5
getSum(100)
# [1] 100
# [1] 10
# [1] 1
getSum( 23)
# [1] 23
# [1] 5
I have a function that I want to write in tail recursive form. The function calculates the number of ways to get the sum of k by rolling an s sided die n times. I have seen the mathematical solution for this function on this answer. It is as follows:
My reference recursive implementation in R is:
sum_ways <- function(n_times, k_sum, s_side) {
if (k_sum < n_times || k_sum > n_times * s_side) {
return(0)
} else if (n_times == 1) {
return(1)
} else {
sigma_values <- sapply(
1:s_side,
function(j) sum_ways(n_times - 1, k_sum - j, s_side)
)
return(sum(sigma_values))
}
}
I have tried to re-write the function in continuation passing style as I have learned from this answer, but I wasn't successful. Is there a way to write this function in tail-recursive form?
EDIT
I know that R doesn't optimise for tail-recursion. My question is not R specific, a solution in any other language is just as welcome. Even if it is a language that does not optimise for tail-recursion.
sapply isn't in continuation-passing style, so you have to replace it.
Here's a translation to continuation-passing style in Python (another language that does not have proper tail calls):
def sum_ways_cps(n_times, k_sum, s_side, ctn):
"""Compute the number of ways to get the sum k by rolling an s-sided die
n times. Then pass the answer to ctn."""
if k_sum < n_times or k_sum > n_times * s_side:
return ctn(0)
elif n_times == 1:
return ctn(1)
else:
f = lambda j, ctn: sum_ways_cps(n_times - 1, k_sum - j, s_side, ctn)
return sum_cps(1, s_side + 1, 0, f, ctn)
def sum_cps(j, j_max, total_so_far, f, ctn):
"""Compute the sum of f(x) for x=j to j_max.
Then pass the answer to ctn."""
if j > j_max:
return ctn(total_so_far)
else:
return f(j, lambda result: sum_cps(j + 1, j_max, total_so_far + result, f, ctn))
sum_ways_cps(2, 7, 6, print) # 6
Try this (with recursion, we need to think of a linear recurrence relation if we want a tail recursive version):
f <- function(n, k) {
if (n == 1) { # base case
return(ifelse(k<=6, 1, 0))
} else if (k > n*6 | k < n) { # some validation
return(0)
}
else {
# recursive calls, f(1,j)=1, 1<=j<=6, otherwise 0
return(sum(sapply(1:min(k-n+1, 6), function(j) f(n-1,k-j))))
}
}
sapply(1:13, function(k) f(2, k))
# [1] 0 1 2 3 4 5 6 5 4 3 2 1 0
The Julia examples to compare performance against R seem particularly convoluted. https://github.com/JuliaLang/julia/blob/master/test/perf/perf.R
What is the fastest performance you can eke out of the two algorithms below (preferably with an explanation of what you changed to make it more R-like)?
## mandel
mandel = function(z) {
c = z
maxiter = 80
for (n in 1:maxiter) {
if (Mod(z) > 2) return(n-1)
z = z^2+c
}
return(maxiter)
}
mandelperf = function() {
re = seq(-2,0.5,.1)
im = seq(-1,1,.1)
M = matrix(0.0,nrow=length(re),ncol=length(im))
count = 1
for (r in re) {
for (i in im) {
M[count] = mandel(complex(real=r,imag=i))
count = count + 1
}
}
return(M)
}
assert(sum(mandelperf()) == 14791)
## quicksort ##
qsort_kernel = function(a, lo, hi) {
i = lo
j = hi
while (i < hi) {
pivot = a[floor((lo+hi)/2)]
while (i <= j) {
while (a[i] < pivot) i = i + 1
while (a[j] > pivot) j = j - 1
if (i <= j) {
t = a[i]
a[i] = a[j]
a[j] = t
}
i = i + 1;
j = j - 1;
}
if (lo < j) qsort_kernel(a, lo, j)
lo = i
j = hi
}
return(a)
}
qsort = function(a) {
return(qsort_kernel(a, 1, length(a)))
}
sortperf = function(n) {
v = runif(n)
return(qsort(v))
}
sortperf(5000)
The key word in this question is "algorithm":
What is the fastest performance you can eke out of the two algorithms below (preferably with an explanation of what you changed to make it more R-like)?
As in "how fast can you make these algorithms in R?" The algorithms in question here are the standard Mandelbrot complex loop iteration algorithm and the standard recursive quicksort kernel.
There are certainly faster ways to compute the answers to the problems posed in these benchmarks – but not using the same algorithms. You can avoid recursion, avoid iteration, and avoid whatever else R isn't good at. But then you're no longer comparing the same algorithms.
If you really wanted to compute Mandelbrot sets in R or sort numbers, yes, this is not how you would write the code. You would either vectorize it as much as possible – thereby pushing all the work into predefined C kernels – or just write a custom C extension and do the computation there. Either way, the conclusion is that R isn't fast enough to get really good performance on its own – you need have C do most of the work in order to get good performance.
And that's exactly the point of these benchmarks: in Julia you never have to rely on C code to get good performance. You can just write what you want to do in pure Julia and it will have good performance. If an iterative scalar loop algorithm is the most natural way to do what you want to do, then just do that. If recursion is the most natural way to solve the problem, then that's ok too. At no point will you be forced to rely on C for performance – whether via unnatural vectorization or writing custom C extensions. Of course, you can write vectorized code when it's natural, as it often is in linear algebra; and you can call C if you already have some library that does what you want. But you don't have to.
We do want to have the fairest possible comparison of the same algorithms across languages:
If someone does have faster versions in R that use the same algorithm, please submit patches!
I believe that the R benchmarks on the julia site are already byte-compiled, but if I'm doing it wrong and the comparison is unfair to R, please let me know and I will fix it and update the benchmarks.
Hmm, in the Mandelbrot example the matrix M has its dimensions transposed
M = matrix(0.0,nrow=length(im), ncol=length(re))
because it's filled by incrementing count in the inner loop (successive values of im). My implementation creates a vector of complex numbers in mandelperf.1 and operates on all elements, using an index and subsetting to keep track of which elements of the vector have not yet satisfied the condition Mod(z) <= 2
mandel.1 = function(z, maxiter=80L) {
c <- z
result <- integer(length(z))
i <- seq_along(z)
n <- 0L
while (n < maxiter && length(z)) {
j <- Mod(z) <= 2
if (!all(j)) {
result[i[!j]] <- n
i <- i[j]
z <- z[j]
c <- c[j]
}
z <- z^2 + c
n <- n + 1L
}
result[i] <- maxiter
result
}
mandelperf.1 = function() {
re = seq(-2,0.5,.1)
im = seq(-1,1,.1)
mandel.1(complex(real=rep(re, each=length(im)),
imaginary=im))
}
for a 13-fold speed-up (the results are equal but not identical because the original returns numeric rather than integer values).
> library(rbenchmark)
> benchmark(mandelperf(), mandelperf.1(),
+ columns=c("test", "elapsed", "relative"),
+ order="relative")
test elapsed relative
2 mandelperf.1() 0.412 1.00000
1 mandelperf() 5.705 13.84709
> all.equal(sum(mandelperf()), sum(mandelperf.1()))
[1] TRUE
The quicksort example doesn't actually sort
> set.seed(123L); qsort(sample(5))
[1] 2 4 1 3 5
but my main speed-up was to vectorize the partition around the pivot
qsort_kernel.1 = function(a) {
if (length(a) < 2L)
return(a)
pivot <- a[floor(length(a) / 2)]
c(qsort_kernel.1(a[a < pivot]), a[a == pivot], qsort_kernel.1(a[a > pivot]))
}
qsort.1 = function(a) {
qsort_kernel.1(a)
}
sortperf.1 = function(n) {
v = runif(n)
return(qsort.1(v))
}
for a 7-fold speedup (in comparison to the uncorrected original)
> benchmark(sortperf(5000), sortperf.1(5000),
+ columns=c("test", "elapsed", "relative"),
+ order="relative")
test elapsed relative
2 sortperf.1(5000) 6.60 1.000000
1 sortperf(5000) 47.73 7.231818
Since in the original comparison Julia is about 30 times faster than R for mandel, and 500 times faster for quicksort, the implementations above are still not really competitive.