Reputation: 9
I want to find the backtracks sequence in the form of data (as it is from collatz conjecture tibble data from 1 to 10,000) at some point goes above the starting value in that sequence.
This is my output for data frame:
structure(list(start = 1:6, seq = list(1L, c(2, 1), c(3, 10,
5, 16, 8, 4, 2, 1), c(4, 2, 1), c(5, 16, 8, 4, 2, 1), c(6, 3,
10, 5, 16, 8, 4, 2, 1)), length = c(1, 2, 8, 3, 6, 9), parity = c("Odd",
"Even", "Odd", "Even", "Odd", "Even"), max_val = c(1, 2, 16,
4, 16, 16)), row.names = c(NA, -6L), class = c("tbl_df", "tbl",
"data.frame"))
This is how i did:
has_backtrack <- function(seq) {
length_seq <- length(seq)
if (length_seq < 3) {
return(FALSE)
}
for (i in 2:(length_seq - 1)) {
if (seq[i] < seq[1] && seq[i + 1] > seq[i]) {
return(TRUE)
}
}
}
However, for my current code it only shows whether a sequence increases but not above the first value.
Backtracks def: is when a sequence reaches a value that is less than the starting integer, but then increases again ABOVE the starting value/integer it can be at least once before reaching one.
Upvotes: 0
Views: 85
Reputation: 76402
I am not sure that the following is what you want. It uses R's vectorized instructions to get all points where the input sequence increases in one instruction, making the code much simpler, without for
loops.
The function has_backtrack
returns the indices to the points where the sequence increases, not the sequences values.
The functions next_collatz
and collatz
are inspired in this R-bloggers code.
next_collatz <- function(num) {
if(num == 1L) {
invisible(NULL)
} else if(num %% 2L == 0L) {
num / 2L
} else 3L * num + 1L
}
collatz <- function(x) {
result <- x
while(x != 1L) {
x <- next_collatz(x)
result <- c(result, x)
}
result
}
has_backtrack <- function(x) which(diff(x) > 0L)
cltz_6 <- collatz(6)
has_backtrack(cltz_6)
#> [1] 2 4
i <- has_backtrack(cltz_6)
cltz_6[i]
#> [1] 3 5
Created on 2023-09-24 with reprex v2.0.2
Another example, with a strictly decreasing input Collatz sequence.
(cltz_16 <- collatz(16))
#> [1] 16 8 4 2 1
(i <- has_backtrack(cltz_16))
#> integer(0)
cltz_16[i]
#> numeric(0)
Created on 2023-09-24 with reprex v2.0.2
With the data set posted in the question, the Collatz sequences column is a list column and the function has_backtrack
can be lapply
ed as follows.
The results show that
inx_list <- lapply(df1$seq, has_backtrack)
inx_list
#> [[1]]
#> integer(0)
#>
#> [[2]]
#> integer(0)
#>
#> [[3]]
#> [1] 1 3
#>
#> [[4]]
#> integer(0)
#>
#> [[5]]
#> [1] 1
#>
#> [[6]]
#> [1] 2 4
Created on 2023-09-24 with reprex v2.0.2
And to get the values before the increase point, use Map
.
Map(\(x, i) x[i], df1$seq, inx_list)
#> [[1]]
#> integer(0)
#>
#> [[2]]
#> numeric(0)
#>
#> [[3]]
#> [1] 3 5
#>
#> [[4]]
#> numeric(0)
#>
#> [[5]]
#> [1] 5
#>
#> [[6]]
#> [1] 3 5
Created on 2023-09-24 with reprex v2.0.2
df1 <-
structure(list(
start = 1:6,
seq = list(1L, c(2, 1), c(3, 10, 5, 16, 8, 4, 2, 1),
c(4, 2, 1), c(5, 16, 8, 4, 2, 1), c(6, 3, 10, 5, 16, 8, 4, 2, 1)),
length = c(1, 2, 8, 3, 6, 9),
parity = c("Odd", "Even", "Odd", "Even", "Odd", "Even"),
max_val = c(1, 2, 16, 4, 16, 16)),
row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))
Created on 2023-09-24 with reprex v2.0.2
Upvotes: 1
Reputation: 72758
Consider z
as the remainder after the first value. Subset z
on id(cumsum(z < x[1]) > 1
) and look if any
of them is TRUE
.
has_backtrack2 <- function(x) {
if (length(x) < 3) FALSE
else {
z <- x[-1]
any(z[cumsum(z < x[1]) > 1L] > x[1])
}
}
Using sapply
sapply(df$seq, has_backtrack2)
# [1] FALSE FALSE FALSE FALSE FALSE TRUE
Or for conveniece Vectorize
d.
has_backtrack2v <- Vectorize(has_backtrack2)
has_backtrack2v(df$seq)
# [1] FALSE FALSE FALSE FALSE FALSE TRUE
Assuming the desired "integer 6" means which
sequence has backtrack, you can get it accordingly:
which(has_backtrack2v(df$seq))
# [1] 6
Upvotes: 0