Create sequence in R - r

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

Related

Prime number generator using for loop in R

Trying to create a for loop in which you input a number and the function tells you whether or not the number is prime or not. I used two examples being n1 <- 100 and n2 <- 101.
Here is my code below:
n1 <- 100
n2 <-101
answer = TRUE
for(i in n1){
if (n1 %% (i-1) == 0){
prime1=FALSE
}else {
prime1=TRUE
}
}
prime1
answer = TRUE
for (i in n2){
if (n2 %% (i-1) == 0){
prime2=FALSE
}else {
prime2=TRUE
}
}
prime2
The problem is that the function will generate the same output for both depending on one difference in the code.
In the first "if" statement, both functions will generate output TRUE if I put in the line (i-1). However, if I instead change the line of code to "n1 %% i == 0" as opposed to "n1 %% (i-1) == 0", both functions generate the output FALSE.
Any pointers? Thanks!
Here's a simple prime checker using a for loop.
With n1 <- 100 :
for(i in seq(2, ceiling(sqrt(n1)))) {
if(n1 %% i == 0){
print(FALSE)
break
}
if(i == ceiling(sqrt(n1)))
print(TRUE)
}
#> [1] FALSE
With n2 <- 101
for(i in seq(2, ceiling(sqrt(n2)))) {
if(n2 %% i == 0){
print(FALSE)
break
}
if(i == ceiling(sqrt(n2)))
print(TRUE)
}
#> [1] TRUE

How can you check whether a sequence is an 'almost increasing sequence' in R?

A sequence (e.g. c(1,2,3,4)) is almost increasing when we can remove exactly one element from the sequence and get a strictly increasing sequence (i.e. a0 < a1 < ... < an). I'm trying to find a way to check whether a sequence is almost increasing. If it is, I want to return TRUE; if it isn't I want to output FALSE. I've got this far:
solution <- function(sequence) {
sequence1 <- unlist(sequence)
if (length(sequence1) == 1) {
next
}
count <- 0
for (i in (length(sequence1) - 1)) {
if (sequence1[i + 1] > sequence1[i]) {
next
} else if (((sequence1[i + 2] > sequence1[i]) & count == 0) & i !=
length(sequence1)-1) {
sequence1 <- sequence1[- (i + 1)]
count <- count + 1
} else if ((sequence1[i + 1] > sequence1[i - 1]) & count == 0 & i != 1) {
sequence1 <- sequence1[-i]
count <- count + 1
} else {
return(FALSE)
}
}
return(TRUE)
}
I've used unlist() because codesignal, for some reason, doesn't accept you to refer to the function argument within the function. This works for some sequences: solution(c(4,1,5)) correctly returns TRUE. It doesn't work for others: solution(c(1, 1, 1, 2, 3)) incorrectly returns TRUE. solution(c(2,1,2,1)) correctly returns FALSE and yet solution(c(1,2,1,2)) incorrectly returns TRUE. I've lost my grip on what's going on. I wonder if anyone can spot anything?
Clarification: the basic idea of my code is to iterate through the sequence and for each element check whether its right neighbour is a bigger number. If it isn't, then we have two options: get rid of i or get rid of i+1, so I check those in turn. Since we can only make one change, i've added the condition that if count is 1, then we skip to finish. Also, if the index is 1 then we can't check i-1, and if the index is length(sequence)-1, then we can't check i+2, so i've added those conditions in to make sure my code skips to the other option if appropriate.
Here is a solution which works for me. The idea is that diff(x) has negative elements for every downwards step in x. For example, min(diff(x)) is positive, if x is strictly increasing. If diff(x)[i] <= 0 for exactly one index i, we have to check whether either removing x[i] or removing x[i+1] makes the sequence strictly increasing. The following function passed all tests I tried:
check_almost <- function(x) {
if (length(x) < 2) {
return(TRUE)
}
d <- diff(x)
i <- which(d <= 0)
if (length(i) == 0) {
return(TRUE) # strictly increasing
} else if (length(i) > 1) {
return(FALSE)
}
return(i == 1 || # we can remove x[1]
i == length(d) || # we can remove x[length(x)]
d[i-1]+d[i] > 0 || # we can remove x[i]
d[i] + d[i+1] > 0) # we can remove x[i+1]
}

Slow recursion even with memoization in R

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.

How to use the output of an r function in another function?

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!

In R calculate fibonnaci using dynamic programing

I tried to write a function to calculate the nth Fibonnaci number in R. I can do this recursively.
fibonacci = function(n){
if (n == 1) {return(1)}
if (n == 2) {return(2)}
return(fibonacci(n - 1) + fibonacci(n - 2))
}
I couldn't find any examples in R but from guide in other languages I came up with the following. However it doesn't seem to run any faster.
fibonacci = function(n, lookup = NULL){
if (is.null(lookup)) {
lookup = integer(n + 1)
}
if (n == 1) {return(1)}
if (n == 2) {return(2)}
lookup[1] = 1
lookup[2] = 2
if (lookup[n - 1] == 0) {
lookup[n - 1] = fibonacci(n - 1, lookup)
}
if (lookup[n - 2] == 0) {
lookup[n - 2] = fibonacci(n - 2, lookup)
}
return(lookup[n - 1] + lookup[n - 2])
}
The problem with your solution is that your lookup vector is always local to the call frame environment and new solutions are not propagated up to the callers, i.e., changes to the lookup vector are lost when the function returns. In order to make a persistent variable a la static variables in C, you may create an attribute to the function that acts as a memoizer. Here is one solution:
fibonaccid = function(n, init=T){
if (init) {
lookup <- integer(n + 1)
lookup[1] <- 1
lookup[2] <- 2
} else {
lookup <- attr(fibonaccid, ".lookup")
}
# ... calculate lookup as before, recurse with fibonaccid(...,init=F)
attr(fibonaccid, ".lookup") <<- lookup
return(lookup[n - 1] + lookup[n - 2])
}
This indeed runs much faster:
R> system.time(print(fibonacci(35)))
[1] 14930352
user system elapsed
20.923 0.140 21.446
R> system.time(print(fibonaccid(35)))
[1] 14930352
user system elapsed
0.202 0.006 0.209
See this post for more information.

Resources