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
Related
I am writing a code for the factorial function. My code is as follows:
f <- function(n) {
factorial <- 1
if( n < 0 )
print("Factorial of negative numbers is not possible")
else if( n == 0 )
print("Factorial of 0 is 1")
else {
for(i in 1:n)
factorial <- factorial * i
print(paste("Factorial of ",n," is ",factorial))
}
}
My problem with this code is for decimal numbers as input. For example for f(6.5) my code computes 720, but we know 6.5 ! does not exist. For decimal numbers like 6.5, 5/2, or sqrt(2) I would like to see a message like
"The factorial for this number does not exist".
How can I fix this problem in my code?
Something like this? This stops if n and as.integer(n) is not identical.
f <- function(n) {
if (as.integer(n) != n) {
stop("The factorial for this number does not exist")
}
factorial <- 1
if( n < 0 )
print("Factorial of negative numbers is not possible")
else if( n == 0 )
print("Factorial of 0 is 1")
else {
for(i in 1:n)
factorial <- factorial * i
print(paste("Factorial of ",n," is ",factorial))
}
}
f(5)
# [1] "Factorial of 5 is 120"
f(6.5)
# Error in f(6.5) : The factorial for this number does not exist
f(5/2)
# Error in f(5/2) : The factorial for this number does not exist
f(sqrt(2))
# Error in f(sqrt(2)) : The factorial for this number does not exist
Hi I was wondering if someone knows how to realize this sequence in R?
Consider a sequence with following requirement.
a1=1
an=an-1+3 (If n is a even number)
an=2×an-1-5 (If n is a odd number)
e.g. 1,4,3,6,7,10,15,...
a30=?
Try the following.
It will return the entire sequence, not just the last element.
seq_chih_peng <- function(n){
a <- integer(n)
a[1] <- 1
for(i in seq_along(a)[-1]){
if(i %% 2 == 0){
a[i] <- a[i - 1] + 3
}else{
a[i] <- 2*a[i - 1] - 5
}
}
a
}
seq_chih_peng(30)
Note that I do not include code to check for input errors such as passing n = 0 or a negative number.
If you want to do it recursively, you just have the write the equations in your function as follows:
sequence <- function(n) {
if (n == 1) return(1)
else if (n > 1) {
if (n %% 2 == 1) {
return(2 * sequence(n - 1) - 5)
}else{
return(sequence(n - 1) + 3)
}
}else{
stop("n must be stricly positive")
}
}
sequence(30)
# returns 32770
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
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
I spent a little time hacking an R implementation of the lehmann primality test. The function design I borrowed from http://davidkendal.net/articles/2011/12/lehmann-primality-test
Here is my code:
primeTest <- function(n, iter){
a <- sample(1:(n-1), 1)
lehmannTest <- function(y, tries){
x <- ((y^((n-1)/2)) %% n)
if (tries == 0) {
return(TRUE)
}else{
if ((x == 1) | (x == (-1 %% n))){
lehmannTest(sample(1:(n-1), 1), (tries-1))
}else{
return(FALSE)
}
}
}
lehmannTest(a, iter)
}
primeTest(4, 50) # false
primeTest(3, 50) # true
primeTest(10, 50)# false
primeTest(97, 50) # gives false # SHOULD BE TRUE !!!! WTF
prime_test<-c(2,3,5,7,11,13,17 ,19,23,29,31,37)
for (i in 1:length(prime_test)) {
print(primeTest(prime_test[i], 50))
}
For small primes it works but as soon as i get around ~30, i get a bad looking message and the function stops working correctly:
2: In lehmannTest(a, iter) : probable complete loss of accuracy in modulus
After some investigating i believe it has to do with floating point conversions. Very large numbers are rounded so that the mod function gives a bad response.
Now the questions.
Is this a floating point problem? or in my implementation?
Is there a purely R solution or is R just bad at this?
Thanks
Solution:
After the great feedback and a hour reading about modular exponentiation algorithms i have a solution. first it is to make my own modular exponentiation function. The basic idea is that modular multiplication allows you calculate intermediate results. you can calculate the mod after each iteration, thus never getting a giant nasty number that swamps the 16-bit R int.
modexp<-function(a, b, n){
r = 1
for (i in 1:b){
r = (r*a) %% n
}
return(r)
}
primeTest <- function(n, iter){
a <- sample(1:(n-1), 1)
lehmannTest <- function(y, tries){
x <- modexp(y, (n-1)/2, n)
if (tries == 0) {
return(TRUE)
}else{
if ((x == 1) | (x == (-1 %% n))){
lehmannTest(sample(1:(n-1), 1), (tries-1))
}else{
return(FALSE)
}
}
}
if( n < 2 ){
return(FALSE)
}else if (n ==2) {
return(TRUE)
} else{
lehmannTest(a, iter)
}
}
primeTest(4, 50) # false
primeTest(3, 50) # true
primeTest(10, 50)# false
primeTest(97, 50) # NOW IS TRUE !!!!
prime_test<-c(5,7,11,13,17 ,19,23,29,31,37,1009)
for (i in 1:length(prime_test)) {
print(primeTest(prime_test[i], 50))
}
#ALL TRUE
Of course there is a problem with representing integers. In R integers will be represented correctly up to 2^53 - 1 which is about 9e15. And the term y^((n-1)/2) will exceed that even for small numbers easily. You will have to compute (y^((n-1)/2)) %% n by continually squaring y and taking the modulus. That corresponds to the binary representation of (n-1)/2.
Even the 'real' number theory programs do it like that -- see Wikipedia's entry on "modular exponentiation". That said it should be mentioned that programs like R (or Matlab and other systems for numerical computing) may not be a proper environment for implementing number theory algorithms, probably not even as playing fields with small integers.
Edit: The original package was incorrect
You could utilize the function modpower() in package 'pracma' like this:
primeTest <- function(n, iter){
a <- sample(1:(n-1), 1)
lehmannTest <- function(y, tries){
x <- modpower(y, (n-1)/2, n) # ((y^((n-1)/2)) %% n)
if (tries == 0) {
return(TRUE)
}else{
if ((x == 1) | (x == (-1 %% n))){
lehmannTest(sample(1:(n-1), 1), (tries-1))
}else{
return(FALSE)
}
}
}
lehmannTest(a, iter)
}
The following test is successful as 1009 is the only prime in this set:
prime_test <- seq(1001, 1011, by = 2)
for (i in 1:length(prime_test)) {
print(primeTest(prime_test[i], 50))
}
# FALSE FALSE FALSE FALSE TRUE FALSE
If you are just using base R, I would pick #2b... "R is bad at this". In R integers (which you do not appear to be using) are restricted to 16-bit accuracy. Above that limit you will get rounding errors. You should probably be looking at: package:gmp or package:Brobdingnag. Package:gmp has large-integer and large-rational classes.