This is one solution I think of. Maybe not the best but seems clean to me.Your equation makes me think of recursion.
First we are working on a vector A, then we will see how this could be apply thanks to purrr to a largeA compose of J vectors of size N.
Inputs should be a vector A, and parameters x, y, z. For first element we have an initialization. (your fist data row in your data.frame).
Then we apply a function recursively until the last element of A (B[5] needs A[4], but A[5] is not useful). During the recursion we save
each results as a on row tibble. At the end of the recursion we binds those tibbles and add the A vector to get results as a data.frame.
The code for what I just explained:
# Parameters
x <- 0.01
y <- 0.015
z <- 0.03
# for reproducibility
set.seed(42)
# We define A as a vector
A <- runif(5, 0, 2)
# Main function to generate the result
main <- function(A, x, y, z) {
# initialization function
init <- function(x, y, z) {
B <- 1
C <- 1
D <- B * x + C * y
tibble::data_frame(B = B, C = B, D = D)
}
# initialization of B, C, D
init <- init(x, y, z)
# create resulting object
res <- list(init)
# recursion on vector A
g <- function(A, B, C, D, x, y, z) {
# compute B, C, D
B <- A[1] * B - D
C <- max(C + z, B)
D <- B * x + C * y
# update res object in previous environnement
res <<- append(res, list(tibble::tibble(B= B, C = C, D = D)))
# reduce vector A by 1 element
A <- A[-1]
# stop at last element of A
if (length(A)==1) return(NULL)
# if not last element continue
g(A,B,C,D, x, y, z)
}
# apply recursion function
g(A, init$B, init$C, init$D, x, y, z)
# get back the result as a tibble
tibble::add_column(dplyr::bind_rows(res), A, .before = 1)
}
# lets get our result!
main(A, x, y, z)
#> # A tibble: 5 x 4
#> A B C D
#> <dbl> <dbl> <dbl> <dbl>
#> 1 1.83 1.00 1.00 0.0250
#> 2 1.87 1.80 1.80 0.0451
#> 3 0.572 3.34 3.34 0.0834
#> 4 1.66 1.83 3.37 0.0688
#> 5 1.28 2.96 3.40 0.0806
It works for a vector A.
Now if we have J set of vector A of size N, we can use purrr to apply on each set.
# parameters
n <- 5
j <- 3
set.seed(42)
# we need purrr
library(purrr)
# create a list of j vector of size n
rerun(j, runif(n, 0, 2)) %>%
# name those set for next step
set_names(nm = paste0("set_", seq_along(.))) %>%
# apply main function on each vectros and get back a one tibble with a set_id colum
map_df(~ main(.x, x = x, y = y, z = z), .id = "set_id")
#> # A tibble: 15 x 5
#> set_id A B C D
#> <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 set_1 1.83 1.00 1.00 0.0250
#> 2 set_1 1.87 1.80 1.80 0.0451
#> 3 set_1 0.572 3.34 3.34 0.0834
#> 4 set_1 1.66 1.83 3.37 0.0688
#> 5 set_1 1.28 2.96 3.40 0.0806
#> 6 set_2 1.04 1.00 1.00 0.0250
#> 7 set_2 1.47 1.01 1.03 0.0256
#> 8 set_2 0.269 1.47 1.47 0.0367
#> 9 set_2 1.31 0.358 1.50 0.0260
#> 10 set_2 1.41 0.445 1.53 0.0274
#> 11 set_3 0.915 1.00 1.00 0.0250
#> 12 set_3 1.44 0.890 1.03 0.0244
#> 13 set_3 1.87 1.26 1.26 0.0314
#> 14 set_3 0.511 2.32 2.32 0.0579
#> 15 set_3 0.925 1.13 2.35 0.0465
we get the result we are looking for as one table. I you prefer several list's elements.
set.seed(42)
rerun(j, runif(n, 0, 2)) %>%
map(~ main(.x, x = x, y = y, z = z)) %>%
str(2)
#> List of 3
#> $ :Classes 'tbl_df', 'tbl' and 'data.frame': 5 obs. of 4 variables:
#> ..$ A: num [1:5] 1.83 1.874 0.572 1.661 1.283
#> ..$ B: num [1:5] 1 1.8 3.34 1.83 2.96
#> ..$ C: num [1:5] 1 1.8 3.34 3.37 3.4
#> ..$ D: num [1:5] 0.025 0.0451 0.0834 0.0688 0.0806
#> $ :Classes 'tbl_df', 'tbl' and 'data.frame': 5 obs. of 4 variables:
#> ..$ A: num [1:5] 1.038 1.473 0.269 1.314 1.41
#> ..$ B: num [1:5] 1 1.013 1.467 0.358 0.445
#> ..$ C: num [1:5] 1 1.03 1.47 1.5 1.53
#> ..$ D: num [1:5] 0.025 0.0256 0.0367 0.026 0.0274
#> $ :Classes 'tbl_df', 'tbl' and 'data.frame': 5 obs. of 4 variables:
#> ..$ A: num [1:5] 0.915 1.438 1.869 0.511 0.925
#> ..$ B: num [1:5] 1 0.89 1.26 2.32 1.13
#> ..$ C: num [1:5] 1 1.03 1.26 2.32 2.35
#> ..$ D: num [1:5] 0.025 0.0244 0.0314 0.0579 0.0465
Hope it helps!
Created on 2018-01-20 by the reprex package (v0.1.1.9000).