Find perfect number using while loop in R - r

I was trying to find perfect number.
Perfect number is that the sum of its factors(including 1) equals itself.
I need to find the first and second perfect number 6 and 28.
So I start from number 2 until I find 2 perfect numbers.
Here is the code:
num.perfect <- 2
count <- 0
iter <- 2
while(count < num.perfect)
{
divisor <- 1
for(i in 2:iter) #find the factors of a number
{
if(iter%%i==0)
{
divisor <- c(divisor, i)
}
}# end for loop
if(sum(divisor)==iter) #print the perfect number
{
print(paste(iter, " is a perfect number", sep=""))
count <- count + 1
} # end if
iter <- iter +1
} # end while loop
But the loop keeps running and will not stop. What is wrong with my code?

You can try this code and see whether it does what you want:
facs=function(n) head((1:n)[n%%(1:n)==0],-1)
perf=function(x){
k=numeric(x)
m=i=0
while(m<x){
i=i+1
if(sum(facs(i))==i){m=m+1;k[m]=i}
}
k
}
perf(4)
# [1] 6 28 496 8128

Related

Fibonacci Sequence in R

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

How to create a sequence that increases its step in R

I'm trying to create a sequence that increases its step by one at each interval, but can't manage to do that.
I would like my result to look like this:
vec <- c(1,3,6,10,15,21,28,36,45,55)
So basically, starting from 1, each index is equal to the precedent plus a number that is increasing by 1 step by step, something like
[i]=[i-1]+seq(from=i, to=10, by=1)
but of course this is not the correct notation.
How would you set this up in order to get something like shown in vec? I imagine some loop is necessary in order to have an indices in a vector exponentially increasing.
This is called the Triangular Number Sequence and has the form:
Tn = 1 + 2 + 3 + 4 + 5 + ... + n
This can be created with the cumsum function in R:
cumsum(1:10)
# [1] 1 3 6 10 15 21 28 36 45 55
or something like this if you prefer recursion:
tri_num = function(n){
if(n <= 1){
return(1)
}else{
return(n+tri_num(n-1))
}
}
sapply(1:10, tri_num)

Finding sum of number nearest to specific number

I have following vector of numbers in r
bay_no <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20)
bay_cont <- c(45,25,25,0,19,61,2,134,5,27,0,54,102,97,5,6,65,47,85,0)
count <- 3
bay_to_serve <- sum(bay_cont)/count
In above bay_cont vector I want to find sum which will be close to bay_to_serve in above case bay_to_serve = 268
Now, from (45 till 2) sum is 177 and (45 till 134) sum is 311,so 311 is closest to 268 then it should return the index of i.e 8 from bay_no
We will get one vector from bay_no = 1-8
Again starting from bay_cont from 5 till the sum close to 268
Desired output is
bay_no 1-8,9-14 and then remaining bay_nos
How can we do it in r?
Dunno if there is a smart way to do but I'd think of nested loops.
Your inner loop may look like this (Please note that I have no access to R right now, so I can't test it.):
old_sum = bay_count[1]
for(i in 2:length(by_cont)) {
new_sum <- sum (bay_count[1:i])
if (abs(bay_to_serve - new_sum) < abs(bay_to_serve - old_sum)) {
output <- paste("bay_no", paste(1,i, sep="-"), sep=" ") break
}else{
old_sum <- new_sum
}
}
This way, whenever the sum of the first X entries is smaller than the previous sum, it will break the loop and create an output string. Just add another loop around the first loop and one or to more if statements to run from j:length(by_cont), whereby j is first set to 1 and will be set to i+1 within the inner loop.
You can try:
res <- NULL
i = 1
while(i < length(bay_cont)){
tmp <- which.min(abs(cumsum(bay_cont[i:length(bay_cont)]) - bay_to_serve))
res <- append(res,tmp)
i = tmp + i
}
cumsum(res)
[1] 8 14 19
If you want to break ties specifically you can use rank together with which.min like follows:
which.min(rank(abs(cumsum(bay_cont[i:length(bay_cont)]) - bay_to_serve), ties.method = "last"))
Then I would create a matrix instead of pasting it together:
cbind(c(1, cumsum(res)[-length(cumsum(res))]+1), cumsum(res))
[,1] [,2]
[1,] 1 8
[2,] 9 14
[3,] 15 19
Of course you can paste it together as well:
apply(cbind(c(1, cumsum(res)[-length(cumsum(res))]+1), cumsum(res)), 1, paste, collapse="-")
[1] "1-8" "9-14" "15-19"
My solution uses a dirty for loop but yields the required indizes...
Hope that fits to you?
bay_no <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20)
bay_cont <- c(45,25,25,0,19,61,2,134,5,27,0,54,102,97,5,6,65,47,85,0)
count <- 3
bay_to_serve <- sum(bay_cont)/count
temp_sum=0
for (i in 1:(length(bay_cont)-1)) {
temp_sum=temp_sum+bay_cont[i]
if ( abs(bay_to_serve-temp_sum)<abs(bay_to_serve-(temp_sum +bay_cont[i+1]))) {
print(i)
temp_sum=0
}
}
I probably misunderstand the question, but it seems more easy to do this:
bay_no[ which.min(abs(cumsum(bay_cont) - bay_to_serve)) ]
To start at 5, omit elements 1:4 and add 4 to the which.min index
bay_no[ which.min(abs(cumsum(bay_cont[-(1:4)]) - bay_to_serve))+4 ]

R: Summing the even terms in a Fibonacci Sequence with warnings

I've been set a question on the Fibonacci Sequence and although I've been successful in doing the sequence, I haven't been as lucky summing the even terms up (i.e. 2nd, 4th, 6th... etc.) My code is below as well as the part of the question I am stuck on. Any guidance would be brilliant!
Question:
Write a function which will take as an input x and y and will return either the sum of the first x even Fibonacci numbers or the sum of even Fibonacci numbers less than y.
That means the user will be able to specify either x or y but not both.
You have to return a warning if someone uses both numbers (decide
on the message to return)
Code:
y <- 10
fibvals <- numeric(y)
fibvals[1] <- 1
fibvals[2] <- 1
for (i in 3:y) {
fibvals[i] <- fibvals[i-1]+fibvals[i-2]
if (i %% 2)
v<-sum(fibvals[i])
}
v
To get you started since this sounds like an exercise.
I would split your loop up into steps rather than do the summing within the loop with an if statement. Since you already have the sequence code working, you can just return what is asked for by the user. The missing function would probably help you out here
f <- function(x, y) {
if (missing(y)) {
warning('you must give y')
y <- 10
}
fibvals <- numeric(y)
fibvals[1] <- 1
fibvals[2] <- 1
for (i in 3:y) {
fibvals[i] <- fibvals[i-1]+fibvals[i-2]
}
evens <- fibvals %% 2 == 0
odds <- fibvals %% 2 != 0
if (missing(x)) {
return(sum(fibvals[evens]))
} else return(fibvals)
}
f(y = 20)
# [1] 3382
f(10)
# [1] 1 1 2 3 5 8 13 21 34 55
# Warning message:
# In f(10) : you must give y

Looping through selected values in R

I want to iterate a loop only for some values so I am using this:
present <- c(3,5,7,8)
for(i in present)
{
print(i)
}
which gives me
[1] 3
[1] 5
[1] 7
[1] 8
however I need to jump to the next value within the loop, say I dont want 5 to be printed in above example.
I cannot use next since I want it in nested for like this
present <- c(3,5,7,8)
for(i in present)
{
k <- i
"Jump to next value of present"
while(k < "The next value for i should come here")
{
k <- k + 1
print(k)
}
}
The output would be 3 4 5 6 7 8 but the condition must check value of k if it exceeds next value of i.
Is there anyway to accomplish this?
I'll take help of C to explain further,
for(i=0; i < 10; i++)
{
for(k=i;k <= i+1;k++)
{
printf("%d", k);
}
}
The link contains output of above code
http://codepad.org/relkenY3
It is easy in C since next value is in sequence, but here next value is not known, hence the problem.
What you should do is loop through two vectors:
x <- head(present, -1)
# [1] 3 5 7
y <- tail(present, -1)
# [1] 5 7 8
and the function to do that is mapply (have a look at ?mapply). A close translation of your pseudo-code would be:
invisible(mapply(function(x, y) while(x < y) {x <- x + 1; print(x)}, x, y))
but maybe you'll find this more interesting:
mapply(seq, x + 1, y)
I suspect the answer is to use seq_along and use it as an index into "present", but as others have pointed out your code does not promise to deliver what you expect, even with that simple modification. The K <- K=1 assignment jumps ahead too far to deliver a value of 3 at any point and the termination condition is likewise not clear. It turns into an infinite loop in the form you construct. Work with this;
present <- c(3,5,7,8)
for(i in seq_along(present))
{
k <- i
while(k < length(present) )
{
k <- k + 1
print(present[k])
}
}

Resources