R Simulation Программирование

Question

Разрушение игроков. В этом случае игрок начинает с 6 долларов. Представьте, что игра подбрасывает монету с вероятностью 1/2 выигрыша / проигрыша. Теперь каждая победа дает вам 1 $, а каждая потеря -1 $. Код ниже будет симулировать эту ситуацию несколько раз, и он остановится, если он достигнет 0 $ или определенной суммы, скажем, например, 10 $. Но проблема в том, что я не знаю, как сохранить дорожку его ставки, например, в пробной версии 1 будет показано 6 5 4 3 2 1 0. Как мне это сделать?

gamble <- function(k,n,p) {                                             
   stake <- k                                   
   while (stake > 0 & stake < n) {
         bet <- sample(c(-1,1),1,prob=c(1-p,p))
         stake <- stake + bet }                                                     
    if (stake == 0) return(1) else return(stake)}  
         storage <- vector("list", 100)                                     
         k <- 6       
         n <-  10  
         p <- 1/2  
         trials <- 100
    simlist <- replicate(trials, gamble(k, n, p))              
    print(simlist)

Answer 1

Вот модифицированная версия вашей функции gamble: пустой массив track, инициализированный перед циклом while, будет отслеживать различные значения ставки до точки, где она достигает минимального или максимального значения

gamble <- function(s, mi, ma, p){
  stake <- s
  track <- array()
  counter <- 1
  while(stake > mi & stake < ma) {
    bet <- sample(c(-1,1),1,prob=c(1-p,p))
    stake <- stake + bet
    track[counter] <- stake
    counter = counter + 1
    if (counter > 20) break
  }
  return(track)
}

p <- 0.5
starting_value <- 6
mi <- 0
ma <- 10
trials <- 10
#track <- gamble(starting_value, mi, ma, p)
simlist <- replicate(trials, gamble(starting_value, mi, ma, p)) 

end_sims <- vector()
counter <- 1
for (i in 1:trials) {
  if (simlist[[i]][length(simlist[[i]])] == 0 | simlist[[i]][length(simlist[[i]])] == 10) {
    end_sims[counter] <- i
    counter <- counter + 1
  }
}

Answer 2

Вот другой подход. Первая идея состоит в том, чтобы сделать много испытаний одновременно. Таким образом, вместо оригинальной реализации у нас есть

gamble0 <-
    function(n_trials, k, n, p)
{
    ## create n_trials simulations
    stakes <- rep(k, n_trials)
    trials <- seq_len(n_trials)

    repeat {
        ## bet on all trials still in play, and update
        bet <- sample(c(1, -1), length(trials), TRUE, prob=c(1-p, p))
        stakes[trials] <- stakes[trials] + bet

        ## only continue to follow those trials that have not terminated
        trials <- trials[(stakes[trials] > 0L) & (stakes[trials] < n)]
        if (length(trials) == 0)
            break
    }
    stakes
}

Результат является вектором результатов и вычисляется быстро, потому что мы позволяем R делать векторизованные вычисления (например, вызывая sample() один раз для генерации length(trials) результатов, а не length(trials) * раз).

> n <- 100000
> system.time(answer <- gamble0(n, 6, 10, .5))
   user  system elapsed 
  0.336   0.000   0.338 
> table(answer) / n
answer
      0      10 
0.39973 0.60027 

Чтобы накапливать треки в каждой симуляции, используйте list() для отслеживания каждого трека и триала, которые все еще находятся в игре. После того, как мы записали результаты всех дорожек, преобразуйте список итераций в список дорожек, создав один вектор (через unlist()) дорожек и испытаний и используя split() для повторного разделения вектор на основе треков.

gamble2 <-
    function(n_trials, k, n, p)
{
    ## lists to hold tracks
    tracks <- trials <- list()
    ## initial conditions
    i <- 1L
    stakes <- rep(k, n_trials)
    trial <- seq_len(n_trials)
    repeat {
        ## store current tracks
        tracks[[i]] <- stakes
        trials[[i]] <- trial
        ## still more to do?
        idx <- (stakes > 0L) & (stakes < n)
        if (!any(idx))
            break
        ## update tracks that are still in play
        bet <- sample(c(1, -1), sum(idx), TRUE, c(1 - p, p))
        stakes <- tracks[[i]][idx] + bet
        trial <- trials[[i]][idx]
        ## increment step
        i <- i + 1L
    }
    ## reshape results from list-of-iterations to list-of-tracks
    tracks <- unlist(tracks, use.names = FALSE)
    trials <- unlist(trials, use.names = FALSE)
    tracks <- split(tracks, trials)
    ## report results
    list(iterations = i, tracks = tracks)
}

Это относительно быстро, и им можно манипулировать для исследования свойств, например,

> n_trials <- 100000
> system.time(answer <- gamble2(n_trials, 6, 10, .5))
   user  system elapsed 
  2.172   0.000   2.172 
> tracks0 <- unlist(answer$tracks, use.names=FALSE)
> last <- cumsum(lengths(answer$tracks))
> table(tracks0[last]) / n_trials

      0      10 
0.39794 0.60206 
> hist(lengths(answer$tracks))

(gamble1(), так как отредактировал, пытался быть слишком умным, используя среду для хранения итераций; R стал намного лучше в растущих векторах и списках, так что вид умности не нужен; это также имеет отношение к совету @Gregor избегать растущих векторов - растущие векторы путем индексации после конца x[i] или x[[i]] теперь достаточно эффективны в R).

Answer 3

Я изменил gamble, чтобы вместо обновления одного значения stake каждый раз, stake был вектором, и мы отслеживаем наше место в нем с помощью i. ужасный способ сделать это - добавить новое значение к stake на каждой итерации - сделать векторы длиннее по одному элементу за раз ужасно неэффективно. Вместо этого мы инициализируем stake щедрыми значениями 10k NA. Если у нас кончается, мы ставим еще 10 КБ на конец.

В остальном я сохранил как можно больше вашего кода.

gamble <- function(k, n, p) {
  stake <- rep(NA_real_, 1e4)
  i <- 1
  stake[1] <- k
  while (stake[i] > 0 & stake[i] < n) {
    bet <- sample(c(-1, 1), 1, prob = c(1 - p, p))
    stake[i + 1] <- stake[i] + bet
    i <- i + 1
    if (length(stake) == i) stake <- c(stake, rep(NA_real_, 1e4))
  }
  return(stake[!is.na(stake)])
}

k <- 6
n <-  10
p <- 1 / 2
trials <- 100
simlist <- replicate(trials, gamble(k, n, p))
head(simlist)
# [[1]]
# [1] 6 5 4 3 4 3 2 1 0
# 
# [[2]]
#  [1]  6  7  6  5  6  5  4  3  2  3  4  3  4  5  4  5  4  5  6  7  8  7  8  7  6  7  8  7
# [29]  8  9  8  7  6  7  6  7  8  9 10
# 
# [[3]]
# [1] 6 5 4 3 2 1 0
# 
# [[4]]
#  [1] 6 7 8 9 8 7 6 5 6 5 4 5 6 7 6 7 6 5 4 3 2 3 2 3 4 3 2 1 2 1 0
# 
# [[5]]
#  [1] 6 5 6 5 4 3 4 3 2 3 4 3 4 3 4 3 4 3 4 5 4 5 6 5 6 7 6 5 4 5 4 5 4 3 4 3 2 1 2 1 2 3
# [43] 2 3 2 3 2 1 0
# 
# [[6]]
#  [1]  6  7  6  7  8  7  6  7  8  9 10