Sequence with stopping values - r

This is like a regular tribonacci sequence, however, I want the sequence to stop whenever the term is at the min or max value.
This is what I have started
sequence <- function(a1=0, a2=0, a3=1, min=0, max=30) {
an <- c()
a[1] <- a1
a[2] <- a2
a[3] <- a3
while(a <= max || a >= min) {
a[i] <- a[i-1] + a[i-2] + a[i-3]
an <- c(an, a[i])
}
an
}
Are there any suggestions regarding my code setup, and how to fix the indexing?

Here is a way of coding this using abs():
tribonacci <- function(start=c(0, 0, 1), maxval=15) {
a <- start
i <- 3
while(abs(a[i]) <= maxval) {
i <- i + 1
a[i] <- a[i-3] + a[i-2] + a[i-1]
}
a[1:(i-1)]
}
tribonacci(maxval=24)
# [1] 0 0 1 1 2 4 7 13 24
tribonacci(start=c(0, 1, -3), maxval=30)
# [1] 0 1 -3 -2 -4 -9 -15 -28
Since we use the absolute value, we just need one argument to specify the maximum/minimum.

Related

R if statement incorrectly passes when function used in a tibble

I have confused about this for the past hour and may someone help me out.
Here is my code, where I attempt to create 2 functions that are to be used in a tibble().
n <- 1000
w <- function(x) {
if(-2 <= x & x <= 2) {
return((-3/32)*x^2 + 3/8)
}else{
return(0)
}
}
y <- function(x){
if(0 <= x & x <= 8){
return((1/8)*x^(-2/3) - (1/32))
}else{
return(0)
}
}
df <- tibble(value = seq(2, 9, length.out = n), W = w(value), Y = y(value))
head(df)
As you see, W returns a negative value when values are greater than 2, but in my function w(), there is an if statement to restrict that from happening.
So what's going and how do I solve this issue?
You have used if/else which works for single input (scalar) and you are passing multiple values to it (vector). You should use ifelse which is vectorised.
IfI have understood you correctly in w you want to apply the formula (-3/32)*x^2 + 3/8 but if a value is negative assign as 0. Same for y where you want to apply formula (1/8)*x^(-2/3) - (1/32). You can change your function to.
w <- function(x) {
pmax((-3/32)*x^2 + 3/8, 0)
}
y <- function(x){
pmax((1/8)*x^(-2/3) - (1/32), 0)
}
df <- tibble(value = seq(2, 9, length.out = n), W = w(value), Y = y(value))
head(df)
pmax selects maximum of both the inputs passed. For example,
pmax(-5:5, 0)
#[1] 0 0 0 0 0 0 1 2 3 4 5
Here's code that does what you want to a much smaller test case that still allows looking across the full extent of the ranges of you values (I took the liberty of expanding the range of testing for values because the original case where x was between -2 and 2 had only one instance and that gave 0 for w(2) regardless.
n <- 10
w <- function(x) {
ifelse( -2 <= x & x <= 3 , (-3/32)*x^2 + 3/8, 0)
}
y <- function(x){
ifelse (0 <= x & x <= 8, (1/8)*x^(-2/3) - (1/32), 0)
}
df <- tibble(value = seq(2, 9, length.out = n), W = w(value), Y = y(value))
#-----------
df
# A tibble: 10 x 3
value W Y
<dbl> <dbl> <dbl>
1 2 0 0.0475
2 2.78 -0.348 0.0320
3 3.56 0 0.0224
4 4.33 0 0.0158
5 5.11 0 0.0109
6 5.89 0 0.00708
7 6.67 0 0.00404
8 7.44 0 0.00154
9 8.22 0 0
10 9 0 0
Earlier observations:
Your code threw an error and I addressed it by making a couple of minor adjustments to the w function:
w <- function(x) {
if( (-2 <= x) && (x <= 2)) {
(-3/32)*x^2 + 3/8)
} else { 0 }
}
I think the use of ‘return’ might have been causing problems.
The expression in your first version threw this error:
Error: unexpected '<=' in:
"w <- function(x) {
if(-2 <= x <="
... because the mathematically sensible -2 <= x <= 2 just isn't parse-worthy in R.

How to stop the counting process for the if loop in my code?

I want to stop the counting process for y after it first time meet the condition of y < 0 for each i in the for loop. Which means, the counting process for x will still continue as long as x > 0 (condition stated in the while loop).
I had tried to do something which is if (y < 0 & (y - 120*(16/81)*time + (z-2)) > 0 & z > 2), it make sense for me but the result doesn't make sense because after I run the code, count_x is around 100 (make sense) but count_y is more than 1000 which doesn't make sense since the for loop is only from 1:1000.
count_x <- 0
count_y <- 0
for (i in 1:1000){
x <- 25
y <- 25
t <- 0
while ((x > 0 | y > 0) & t < 100){
time <- rexp(1,100)
u <- runif(1,0,1)
z <- 4/((1-u)^0.2) - 4
if (z < 2){
x <- x + 110*(65/81)*time - z
} else {
y <- y + 120*(16/81)*time - (z-2)
x <- x + 110*(65/81)*time - 2
}
t <- t + time
if (x < 0){
count_x <- count_x + 1
}
if (y < 0 & (y - 120*(16/81)*time + (z-2)) > 0 & z > 2){
count_y <- count_y + 1
}
}
}
For example, during the 1st iteration i=1, the while loop will start and run the code inside the loop. So what I want to do is:
When y first time reach negative value in the first iteration, it will update the count_y by one, then the whole if loop for the counting process of y will stop doing any thing even though the while loop is still continue to run since the if loop for counting process of x might not reach it first negative value yet (the condition for the while loop still satisfied if t is still smaller than 100), so the while loop need to be continue without touching last inner if loop until either t>100 first or x first time reach its negative value. Once, the conditions for while loop do not satisfied, then only go for the 2nd iteration i=2.
Same thing goes to x, the counting process for x will stop doing anything once x first time become a negative value but the while loop will continue working as long as the condition for the while loop still satisfied.
So, there will only be one time update for either x or y for each iteration (so maximum for y should be 1000 since we have 1000 iteration, although unlikely to reach 1000) since the counting process for both x and y will stop once it reaches the first negative value.
I'm thinking to add break function into it but not sure where should I add.
I don't think there's anything wrong with the code. The y counter, to me at least, seems like it is correct. The reason why y is larger is two-fold. Firstly, even though the outer for loop is only 1000, the inner while loop could potentially run for more than a 100 at each i iteration. Secondly, it appears that y goes below 0 before x does, hence why the x counter is smaller.
I've modified your code to include a counter that counts how many while iterations occur, and two variables that store the values of x and y respectively, the first time that y goes below zero.
count_x <- 0
count_y <- 0
while_count <- 0
store_x <- 0
store_y <- 0
a <- 1
b <- 1
for (i in 1:1000){
x <- 25
y <- 25
t <- 0
count_while <- 0
while ((x > 0 | y > 0) & t < 100){
time <- rexp(1,100)
u <- runif(1,0,1)
z <- 4/((1-u)^0.2) - 4
if (z < 2){
x <- x + 110*(65/81)*time - z
} else {
y <- y + 120*(16/81)*time - (z-2)
x <- x + 110*(65/81)*time - 2
}
t <- t + time
if (x < 0){
count_x <- count_x + 1
}
if (y < 0 & (y - 120*(16/81)*time + (z-2)) > 0 & z > 2){
count_y <- count_y + 1
store_y[a] <- y
store_x[a] <- x
a <- a + 1
}
if (y > 0){
count_while <- count_while + 1
}
}
while_count[b] <- count_while
b <- b + 1
}
Checking the averages shows that x is almost exclusively greater than zero the first time y goes below zero. The while loop averages 163 iterations.
mean(store_x)
[1] 38.90333
mean(store_y)
[1] -2.035492
mean(while_count)
[1] 163.052
which(store_x < 0)
[1] 656
So, your counter seems correct to me, x is low simply because it rarely goes below zero. In fact, run the loop for just one iteration by setting for (i in 1:1) and run it several time, you'll find that your count_x rarely goes above zero, despite the while loop iterating over a 100 times. On the other hand, y goes below zero at least once on each i iteration.
I hope this helps!
We will create variables for both x and y that will store and track when both cross zero on each i iteration. First we will check if x or y is zero and if neg is of class NULL. If so, then this is the first negative. We store x_0 or y_0 as 1. Then when counting, we check if x_0 or y_0 is equal to one and if neg is NULL. Then we will add to the counter and record the first negative. Thereafter, the condition evaluates to FALSE.
count_x <- 0
count_y <- 0
while_x <- 0
while_y <- 0
for (i in 1:1000){
x <- 25
y <- 25
t <- 0
x_0 <- 0
y_0 <- 0
neg <- NULL
neg_x <- NULL
while ((x > 0 | y > 0) & t < 100){
time <- rexp(1,100)
u <- runif(1,0,1)
z <- 4/((1-u)^0.2) - 4
if (z < 2){
x <- x + 110*(65/81)*time - z
if (x < 0 & is.null(neg_x)){
x_0 <- 1
}
} else {
y <- y + 120*(16/81)*time - (z-2)
x <- x + 110*(65/81)*time - 2
if (x < 0 & is.null(neg_x)){
x_0 <- 1
}
if (y < 0 & is.null(neg)) {
y_0 <- 1
}
}
t <- t + time
if (x_0 == 1 & is.null(neg_x)){
count_x <- count_x + 1
neg_x <- "First Negative"
x_0 <- x_0 + 1
}
if (y_0 == 1 & is.null(neg)){
count_y <- count_y + 1
neg <- "first negative"
y_0 <- y_0 + 1
}
}
}
You can also place a counter outside the while loop. If x or y is less than 0, add to the counter. This is probably a better solution. The condition will evaluate regardless of when x or y cross below zero, as long as it went below zero, it will evaluate to TRUE
count_x <- 0
count_y <- 0
for (i in 1:1000){
x <- 25
y <- 25
t <- 0
while ((x > 0 | y > 0) & t < 100){
time <- rexp(1,100)
u <- runif(1,0,1)
z <- 4/((1-u)^0.2) - 4
if (z < 2){
x <- x + 110*(65/81)*time - z
} else {
y <- y + 120*(16/81)*time - (z-2)
x <- x + 110*(65/81)*time - 2
}
t <- t + time
}
if(x < 0) {
count_x <- count_x + 1
}
if(y < 0){
count_y <- count_y + 1
}
}
For me, count_y comes out at a 1000 in both cases. This confirms what I said previously, y goes below zero at each while iteration.

Why isn't my random walk simulation working correctly?

I have written the following code to simulate an unbiased random walk on Z^2. With probability 1/4, the "destination" is supposed to move one unit up, left, right, or down. So I made "destination" a matrix with two columns, one for the x-coordinate and one for the y-coordinate, and increment/decrement the appropriate coordinate as according to the value of runif(1).
N_trials <- 10
N_steps <- 10
destination <- matrix(0,N_trials,2)
for(n in 1:N_steps) {
p <- runif(1)
if(p < 1/4) {
destination[n,1] <- destination[n,1] - 1
}
else if(p < 1/2) {
destination[n,1] <- destination[n,1] + 1
}
else if(p < 3/4) {
destination[n,2] <- destination[n,2] + 1
}
else if(p < 1) {
destination[n,2] <- destination[n,2] - 1
}
}
However, the process never seems to move out of the set {(0,0),(1,0),(-1,0),(0,1),(0,-1)}. Why is this? Is there an error in the logic of my code?
Rather than using loops, you can vectorize the random walk.
The idea is to first create a matrix of possible steps:
steps <- matrix(c(0,0,-1,1,-1,1,0,0),nrow = 4)
which is:
[,1] [,2]
[1,] 0 -1
[2,] 0 1
[3,] -1 0
[4,] 1 0
Then you can feed random subscripts into it:
steps[sample(1:4,10,replace = TRUE),]
for example will create a matrix of 9 rows where each row is randomly chosen from the steps matrix.
If you rbind this with c(0,0) as a starting position, and then take the cumulative sum (cumsum) of each column, you have your walk. You can wrap this all in a function:
rand.walk <- function(n){
steps <- matrix(c(0,0,-1,1,-1,1,0,0),nrow = 4)
walk <- steps[sample(1:4,n,replace = TRUE),]
walk <-rbind(c(0,0),walk)
apply(walk,2,cumsum)
}
For example, plot(rand.walk(1000),type = 'l') produces a graph which looks something like:
Here's what I have --- is this what you had in mind?
set.seed(1)
N_trials <- 10
N_steps <- 10
destination <- matrix(0, N_trials, 2)
for(n in 1:(N_steps-1)) {
p <- runif(1)
if(p < 1/4) {
destination[n+1,1] <- destination[n,1] - 1
destination[n+1,2] <- destination[n,2]
}
else if(p < 1/2) {
destination[n+1,1] <- destination[n,1] + 1
destination[n+1,2] <- destination[n,2]
}
else if(p < 3/4) {
destination[n+1,1] <- destination[n,1]
destination[n+1,2] <- destination[n,2] + 1
}
else if(p < 1) {
destination[n+1,1] <- destination[n,1]
destination[n+1,2] <- destination[n,2] - 1
}
}
destination
[,1] [,2]
[1,] 0 0
[2,] 1 0
[3,] 2 0
[4,] 2 1
[5,] 2 0
[6,] 1 0
[7,] 1 -1
[8,] 1 -2
[9,] 1 -1
[10,] 1 0

Replacing the value in between vectors when there is a defined difference

I have question on replacing the value in between the vectors.
The algorithm should find that replacement number when the certain condition is met. In this case finding the number which makes the difference -20 with the previous number. So I prefer to use diff function.
Here is what I mean
x <- c(20,20,0,20,0,5)
> diff(x)
[1] 0 -20 20 -20 5
So in this case 0 makes the difference -20 and I want to change those 0s to 20.
. I know the easiest solution is the directly assigning x[3] <- 20 or x[5] <- 20
However, the 0 location is always different so I need an automated process that can do that. Thanks!
**EDIT
if we need to do this in a grouped data.frame
> df
x gr
1 20 1
2 20 1
3 0 1
4 20 1
5 0 1
6 5 1
7 33 2
8 0 2
9 20 2
10 0 2
11 20 2
12 0 2
How can we implement this ?
modify <- function(x){
value_search = c(0, 33)
value_replacement = c(20, 44)
for (k in 1:length(value_search)) {
index_position = which(x %in% value_search[k])
replacement = value_replacement[k]
for (i in index_position) {
x[i] = replacement
}
}
}
df%>%
group_by(gr)%>%
mutate(modif_x=modify(x))
Error in mutate_impl(.data, dots) :
Evaluation error: 'match' requires vector arguments.
You can do it using which to get the position, i.e.
x[which(diff(x) == -20)+1] <- 20
x
#[1] 20 20 20 20 20 5
if you want a generic way to replace values of a vector based on particular values, i would approach it this way.
x = c(20,20,0,20,0,5)
value_search = 0
value_replacement = 20
index_position = which(x %in% value_search)
for (i in index_position) {
x[i] = value_replacement
}
but this works for single values. if you want to look for multiple values, you can use a nested loop as below:
x = c(20,20,0,20,0,5,33)
value_search = c(0, 33)
value_replacement = c(20, 44)
for (k in 1:length(value_search)) {
index_position = which(x %in% value_search[k])
replacement = value_replacement[k]
for (i in index_position) {
x[i] = replacement
}
}
in response to OP's edits:
any number of ways to do this:
x = c(20,20,0,20,0,5,33)
gr = c(1,1,1,1,2,2,2)
df = data.frame(x, gr)
func_replace <- function(source, value_search, value_replacement) {
for (k in 1:length(source)) {
index_position = which(x %in% value_search[k])
replacement = value_replacement[k]
for (i in index_position) {
source[i] = replacement
} # for i loop
} # for k loop
return(source)
} # func_replace
value_search = c(0, 33)
value_replacement = c(20, 44)
gr_value = 1
df$replacement = with(df, ifelse(gr == gr_value, sapply(df, FUN = function(x) func_replace(x, value_search, value_replacement)), NA))

Euler Project #1 in R

Problem
Find the sum of all numbers below 1000 that can be divisible by 3 or 5
One solution I created:
x <- c(1:999)
values <- x[x %% 3 == 0 | x %% 5 == 0]
sum(values
Second solution I can't get to work and need help with. I've pasted it below.
I'm trying to use a loop (here, I use while() and after this I'll try for()). I am still struggling with keeping references to indexes (locations in a vector) separate from values/observations within vectors. Loops seem to make it more challenging for me to distinguish the two.
Why does this not produce the answer to Euler #1?
x <- 0
i <- 1
while (i < 100) {
if (i %% 3 == 0 | i %% 5 == 0) {
x[i] <- c(x, i)
}
i <- i + 1
}
sum(x)
And in words, line by line this is what I understand is happening:
x gets value 0
i gets value 1
while object i's value (not the index #) is < 1000
if is divisible by 3 or 5
add that number i to the vector x
add 1 to i in order (in order to keep the loop going to defined limit of 1e3
sum all items in vector x
I am guessing x[i] <- c(x, i) is not the right way to add an element to vector x. How do I fix this and what else is not accurate?
First, your loop runs until i < 100, not i < 1000.
Second, replace x[i] <- c(x, i) with x <- c(x, i) to add an element to the vector.
Here is a shortcut that performs this sum, which is probably more in the spirit of the problem:
3*(333*334/2) + 5*(199*200/2) - 15*(66*67/2)
## [1] 233168
Here's why this works:
In the set of integers [1,999] there are:
333 values that are divisible by 3. Their sum is 3*sum(1:333) or 3*(333*334/2).
199 values that are divisible by 5. Their sum is 5*sum(1:199) or 5*(199*200/2).
Adding these up gives a number that is too high by their intersection, which are the values that are divisible by 15. There are 66 such values, and their sum is 15*(1:66) or 15*(66*67/2)
As a function of N, this can be written:
f <- function(N) {
threes <- floor(N/3)
fives <- floor(N/5)
fifteens <- floor(N/15)
3*(threes*(threes+1)/2) + 5*(fives*(fives+1)/2) - 15*(fifteens*(fifteens+1)/2)
}
Giving:
f(999)
## [1] 233168
f(99)
## [1] 2318
And another way:
x <- 1:999
sum(which(x%%5==0 | x%%3==0))
# [1] 233168
A very efficient approach is the following:
div_sum <- function(x, n) {
# calculates the double of the sum of all integers from 1 to n
# that are divisible by x
max_num <- n %/% x
(x * (max_num + 1) * max_num)
}
n <- 999
a <- 3
b <- 5
(div_sum(a, n) + div_sum(b, n) - div_sum(a * b, n)) / 2
In contrast, a very short code is the following:
x=1:999
sum(x[!x%%3|!x%%5])
Here is an alternative that I think gives the same answer (using 99 instead of 999 as the upper bound):
iters <- 100
x <- rep(0, iters-1)
i <- 1
while (i < iters) {
if (i %% 3 == 0 | i %% 5 == 0) {
x[i] <- i
}
i <- i + 1
}
sum(x)
# [1] 2318
Here is the for-loop mentioned in the original post:
iters <- 99
x <- rep(0, iters)
i <- 1
for (i in 1:iters) {
if (i %% 3 == 0 | i %% 5 == 0) {
x[i] <- i
}
i <- i + 1
}
sum(x)
# [1] 2318

Resources