Оценка вероятности языка R - результаты все нулевые? - PullRequest
Новая
       6

Оценка вероятности языка R - результаты все нулевые?

0 голосов
/ 06 ноября 2018

R, отсекаемый ниже, взят из моего 17-недельного броска монеты на Перекрестной проверке стеков, содержит два раздела: первый, чтобы оценить вероятность того, что участники конкурса выиграют конкурс на основе их текущего баллы и количество недель, оставшихся в конкурсе; во-вторых, для проверки оценки с помощью моделирования.

Секция моделирования каждый раз выдает результаты, которые в соответствии с исходным вопросом / ответом подтверждают оценку. Однако каждый раз, когда я запускаю этот фрагмент кода с онлайн-компилятором R , секция оценки не дает ничего, кроме нуля.

Я старался изо всех сил, чтобы отладить код, но я недостаточно знаю о R, чтобы это исправить. Будете ли вы, веселые души из Stack Overflow, любезно взглянуть и подтолкнуть меня в правильном направлении? 

#
# Inputs.
#
x <- c(0,2,9,10,11,12,13,14,15,16,17,20) # Current scores
n <- 17 - 7            # Number of rounds left
n.flips <- 3           # Flips per round
p <- 1/2               # Chance of success per flip

#
# Derived quantities.
#
n.players <- length(x)        # Number of players
m <- n.flips * n              # Number of flips to go
z <- 0:m                      # Possible outcomes for any player
prob <- dbinom(z, n.flips, p) # Their chances

#
# Compute individual chances of wins and ties. 
# 
scores <- sort(unique(x))
chances <- sapply(scores, function(score)
{
  j <- min(which(x == score))

  y1 <- sapply(0:m, function(k)
  {
    exp(sum(pbinom(x[j] + k - x[(1:n.players)[-j]], m, p, log.p=TRUE)))
  })

  y <- sapply(0:n.flips, function(k)
  {
    exp(sum(pbinom(x[j] + k-1 - x[(1:n.players)[-j]], m, p, log.p=TRUE)))
  })

  c(Win=sum(prob * y), Tie=sum(prob * (y1-y)))
})

#
# Check with a simulation.  It will do a few thousand iterations per second.
#
set.seed(17)
sim <- replicate(1e4,
{
  Z <- rbinom(n.players, m, p) # The future results
  final <- x + Z               # The final scores
  scores <- table(final)       # The unique final scores
  k <- length(scores)

  if (scores[k]==1)
  {
    Win <- final == max(final) # Tally who wins
    Tie <- rep(0, n.players)
  }
  else
  {
    Tie <- final == max(final) # Tally who ties
    Win <- rep(0, n.players)
  }

  rbind(Win, Tie)
})

sim <- apply(sim, 1:2, mean)   # Average over the iterations

#
# Display the results.
#
colnames(chances) <- paste(scores)
scores <- sort(unique(x))

sim <- sapply(scores, function(score) sim[, min(which(x==score))])
colnames(sim) <- paste(sort(unique(x)))

print(round(chances, 4))
print(round(sim, 4))

1 Ответ

0 голосов
/ 06 ноября 2018

Я не совсем уверен, что вы делаете, но некоторые проблемы я видел.

В этой строке -

z <- 0:m # Possible outcomes for any player

вы получите вектор-

[1] 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

но каждый игрок подбрасывает монету только 3 раза, поэтому возможные результаты только 0 1 2 3, в результате ваш вектор вероятности выглядит следующим образом-

[1] 0,125 0,375 0,375 0,125 0,000 0,000 0,000 0,000 0,000 0,000 0,000 0,000 0,000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000

(поскольку релевантны только 4 первых результата)

У меня сейчас нет времени, чтобы просмотреть остальную часть вашего кода, может быть, позже. Я надеюсь, что это полезно.

Удачи!

...