Функция Монте-Карло R помогает найти вероятность (шары из задачи урны) - PullRequest
Новая
       27

Функция Монте-Карло R помогает найти вероятность (шары из задачи урны)

1 голос
/ 15 апреля 2019

Я пытаюсь ответить на следующий вопрос, используя простую процедуру выборки Монте-Карло в R: Урна содержит 10 шаров. Два красных, три белых и пять черных. Все 10 рисуются по одному без замены. Найти вероятность того, что первый и последний выпавшие шары являются черными.

Я пробовал два подхода, и ни один из них не работает.

Вот более длинный подход, который для меня более понятен: 

balls <- c(1:10) #Consider 1-5 black, 6-8 white, and 9-10 red.

pick.ball <- function(balls){
sample(x = balls, 1, replace = FALSE)
}

experiment <- function(n){
picks = NULL
keep <- NULL
for(j in 1:n){
   for(i in 1:10){
   picks[i] <- pick.ball(balls = balls)
   }
keep[j] <- ifelse(picks[1] == any(1:5) & picks[10] == any(1:5), 1, 0)
 }
return(length(which(keep == 1))/n)
}

Вот мой второй, более простой подход, который показывает мое непонимание цикла повторения. Не беспокойтесь об этом - это продолжается вечно. Но если бы кто-то мог помочь мне лучше понять почему, это было бы оценено! 

balls <- c(1:10) #Consider 1-5 black, 6-8 white, and 9-10 red.

pick.ball <- function(balls, n){
  keep = NULL
  for(i in 1:n){
  picks <- sample(x = balls, 10, replace = FALSE)
  keep[i] <- ifelse(picks[1] == any(1:5) & picks[10] == any(1:5), 1, 0)
  repeat{
    picks
    if(length(keep) == n){
      break
      }
    }
  }
  return(which(keep == 1)/n)
}

1 Ответ

2 голосов
/ 15 апреля 2019

Вот цикл, который я создал. Вы можете обернуть это в функцию, если хотите. Вместо нумерации шаров я использую буквы. 

urn <- c(rep("B", 5), rep("W", 3), rep("R", 2))

# Set the number of times you want to run the loop

nloops <- 10000


# Create an empty data frame to hold the outcomes of the simulation

m <- structure(list(first = character(),
                    last = character(),
                    is_black = integer()),
               class = "data.frame")

Теперь запустите цикл 


set.seed(456)
for (j in 1:nloops) {
  b <- sample(urn, 10, replace = FALSE)
  m[j, 1:2 ] <- b[c(1, 10)] 
  m[j, 3] <- ifelse(m[j, 1] == "B" & m[j, 2] == "B", 1, 0)
}

head(m)

  first last is_black
1     B    W        0
2     B    B        1
3     B    B        1
4     R    B        0
5     B    R        0
6     R    W        0

Наконец, ответ: 

# Proportion of cases where first and last ball drawn were black

sum(m[ , 3]) / nloops

# This was 0.22
...