Моделирование броска монеты с использованием R - PullRequest
0 голосов
/ 29 января 2020

Я пытаюсь смоделировать смещенную монету, которая многократно подбрасывается до тех пор, пока в голове не появятся 2 головы или не появятся 2 хвоста (тогда бросок останавливается). Я хочу найти вероятность P (две головы подряд появляются перед двумя хвостами подряд).

Ищу помощь по включению "хвостов" в l oop. Спасибо

 flip <- function(bias_p) {                           
    n_flips <- 0                                           
    head <- 0
    tail <- 0
    while (head != 2 & tail != 2) {                                 
       n_flips <- n_flips + 1
       head_flips <- sample(c(1,0), 1, prob = c(bias_p, 1 - bias_p))
       if(head_flips == 1) ((head <- head + 1) & (tail <- 0))
       else ((tail <- tail + 1) & (head <- 0))
       } 
    return(c(head, tail))
    }  
 y <- replicate(5000, flip(0.8))
 length(which(y[1,] ==2)) / (ncol(y)) 

1 Ответ

2 голосов
/ 29 января 2020

Чтобы ваш текущий подход работал, мне пришлось внести несколько изменений:

  • Сгенерировать только один флип на одну итерацию. В настоящее время вы генерируете два совершенно независимых случайных результата за итерацию - hflip и tflip могут не соответствовать друг другу
  • Если переворот - голова, добавьте к nheads и сбросьте ntails в 0
  • Если сальто - хвосты, добавьте к ntails и сбросьте nheads

(использование {} для if / else может сделать его более понятным, чем logi c flow, ваш текущий else подключен только к линии выше него, а не к первому if тесту)

coin_flip <- function(head_p) {                           
    nflips <- 0                                           
    nheads <- 0
    ntails <- 0
    while (nheads != 2 & ntails != 2) {                                 
        nflips <- nflips + 1
        # Only generate 1 flip
        flip <- sample(c(1,0),1,prob=c(head_p,1-head_p))
        # If heads:
        if (flip == 1) {
            nheads <- nheads + 1
            # Reset tails counter
            ntails <- 0
        # There are only two possibilities for what 'flip'
        # can be (1 or 0), so we can just use else rather than 
        # testing for 0 specifically
        } else {
           ntails <- ntails + 1
           nheads <- 0
        }
    } 
    return(nflips)
}

Если вам нужна функция для вывода, 2 головки или 2 на первом месте хвосты, вы можете заменить return(nflips) на return(nheads == 2): функция выдаст 1, если на первом месте 2 головы, 0 на 2 хвоста.

...