Making a "Race" Between Two Variables-CodePudding

I would like to make two variables ("a" and "b") that keep:

taking a random value less ALWAYS than their current value (i.e. a1 > a2 > a3 ...> an , b1 > b2 > b3 ... bn ALWAYS)
until one of them less than or equal to 0:

I showed a demo below:

#iteration 1
a1 = 100 - rnorm(1,5,10)
b1 = 100 -rnorm(1,5,10)

a2 = a1 - rnorm(1,5,10)
b2 = b1 -rnorm(1,5,10)

a3 = a2 - rnorm(1,5,10)
b3 = b2 -rnorm(1,5,10)

#etc.

I would then like to repeat this many times. In the end, this would look something :

Currently, I am doing this manually, and then using the bind_rows() command to "pile" each iteration on top of each other. Can someone please show me a faster way to do this?

Thank you!

CodePudding user response：

Here's a function that runs a single start to 0, nicely configurable, and we can use replicate to run it as many times as needed, returning a list.


to_0 = function(start = 100, fun = runif, ..., n = 1000) {
  if(start <= 0) stop("Must start greater than 0")
  result = start - c(0, cumsum(fun(n, ...)))
  if(all(result > 0)) stop("Didn't reach 0, set a higher n or check inputs.")
  first_0 = match(TRUE, result < 0)
  result[seq_len(first_0)]
}

I used runif as the default instead of your rnorm because you say you want the series to be strictly decreasing, but rnorm is sometimes positive and sometimes negative so it will sometimes lead to increases.

I cut off the series at the first negative value. Since the lengths of each run are different, a data.frame seems like a bad choice, keeping them in a list is better. We can use lengths() to see how long each vector in the list is.

The function is parametrized, so you can easily try out other distributions or custom functions, e.g., to_0(start = 100, fun = rexp, rate = 0.1). Below I demonstrate with the uniform distribution starting at 10.

set.seed(47)
race = replicate(n = 100, to_0(start = 10))
head(race)
# [[1]]
#  [1] 10.00000000  9.02303800  8.64912196  7.88761993  7.06512831  6.49158390  5.80017147  5.41110962  4.94216364  4.39885390  3.47396185
# [12]  3.33516427  2.63317707  2.47098343  1.87167641  1.36564030  0.46366678  0.06316398  0.03221901 -0.03913915
# 
# [[2]]
#  [1] 10.00000000  9.27320918  8.54814801  7.77974923  7.34440424  7.27499236  6.76825217  6.75134855  6.20214287  5.43031741  4.56633348
# [12]  3.59288910  3.24547860  2.60269295  1.75639299  1.73279651  1.72371866  1.38211688  0.71933800  0.04916749 -0.40714758
# 
# [[3]]
#  [1] 10.00000000  9.08923490  9.06189460  8.69397353  8.30179409  8.11077841  7.96295850  7.49701585  6.52812608  6.26480567  5.34558158
# [12]  5.31801508  4.90573089  3.98774633  3.89046321  3.70358854  3.61482042  3.53824450  3.36900151  2.86522484  2.23295349  1.80544403
# [23]  0.82311022  0.73664857 -0.09385818
# 
# [[4]]
#  [1] 10.0000000  9.2172681  8.4175584  8.1672679  7.3683421  7.3373712  7.0319788  6.6512214  5.7210315  5.2732412  4.6817849  4.1065416
# [13]  3.9452541  3.4009742  2.5018050  1.5316136  0.7175295  0.4410275 -0.1859260
# 
# [[5]]
#  [1] 10.00000000  9.91914621  9.90238843  9.82993154  9.33156028  8.90827720  8.44160294  7.46348397  6.76539075  6.27298443  5.97401412
# [12]  5.03395592  4.55537992  3.75737919  2.82175869  2.75045000  2.70081885  2.67523320  2.20266408  2.12695183  1.25880525  0.57011279
# [23]  0.03173135 -0.79275633
# 
# [[6]]
#  [1] 10.0000000  9.9292630  9.6154147  9.0754730  8.7814754  8.5273701  7.6998567  6.8127609  5.9944598  5.6232599  5.1505038  4.8676191
# [13]  4.6337121  4.5868438  4.0435219  3.0981151  2.2621741  1.9925101  1.2104707  0.9334569  0.7574446  0.1643009 -0.5220925

lengths(race)
 #  [1] 20 21 25 19 24 23 21 24 23 22 25 24 19 19 23 17 19 23 25 21 24 25 18 22 24 25 19 19 23 22 19 26 20 23 24 24 22 21 25 23 21 28 19 20 16 20
 # [47] 22 25 20 22 23 23 24 22 19 23 23 23 22 18 22 23 24 21 21 23 21 22 20 25 22 23 21 17 20 20 16 25 21 21 21 20 20 19 24 19 23 24 26 25 20 21
 # [93] 23 17 27 18 30 24 21 23

CodePudding user response：

You could write a smallrecursive function:

fun <- function(x){
  if(any(x < 0)) x 
  else rbind(x, fun(x - abs(rnorm(length(x),5,10)) ))
}

Now for 1 draw of A and B:

set.seed(1)
fun(c(A=100, B=100))
          A          B
x 100.00000 100.000000
x  98.73546  93.163567
x  95.37918  72.210759
x  87.08410  69.006075
x  77.20981  56.622828
x  66.45199  54.676712
x  46.33418  45.778279
x  45.12178  28.631280
x  28.87247  24.080617
x  24.03437   9.642254
   10.82216  -1.296759

We can use this within a function to replicate. Will maintain BASE R although can be simplified in tidyverse:

random_seq <- function(n, start){
  fun <- function(x){
    if(any(x < 0)) c(x)
    else rbind(x, fun(x - abs(rnorm(length(x),5,10)) ))
  }
  R <-replicate(n, data.frame(fun(start), row.names = NULL), simplify = FALSE)
  S <- do.call(rbind, Map(cbind, id = seq(R), R))
  U <-transform(S, time = ave(id, id, FUN = seq_along))
  reshape(U, dir='wide', idvar = 'id', sep='')
}

set.seed(1)
random_seq(4, c(A=20,B=20))
   id A1 B1         A2        B2        A3        B3        A4       B4
1   1 20 20 18.7354619 13.163567 15.379176 -7.789241        NA       NA
4   2 20 20 11.7049223 16.795316  1.830632  4.412069 -8.927182 2.465953
8   3 20 20 -0.1178117 11.101568        NA        NA        NA       NA
10  4 20 20 18.7875942  2.853001  2.538285 -1.697663        NA       NA

BONUS: if interested, fun can directly reproduce the names:

fun <- function(x){
   nms <- as.numeric(sub('\\D ', '',names(x)))   1
   names(x) <- paste0(sub("\\d ", '', names(x)), nms)
  if(any(x < 0)) c(x)
  else c(x, Recall(x - abs(rnorm(length(x),5,10)) ))
}
fun(c(A0=20, B0=30))
       A1        B1        A2        B2        A3        B3 
20.000000 30.000000 11.234808 23.323201 -9.611483  1.544311