Как я могу проверить справедливость d20?

Как я могу проверить справедливость двадцатигранного кубика (d20)? Очевидно, я бы сравнил распределение значений с равномерным распределением. Я смутно помню использование теста хи-квадрат в колледже. Как я могу применить это, чтобы увидеть, честен ли кубик?

Вот пример с кодом R Выводу предшествует #. Честная смерть

rolls <- sample(1:20, 200, replace = T)
table(rolls)
#rolls
# 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 
# 7  8 11  9 12 14  9 14 11  7 11 10 13  8  8  5 13  9 10 11 
 chisq.test(table(rolls), p = rep(0.05, 20))

#         Chi-squared test for given probabilities
#
# data:  table(rolls) 
# X-squared = 11.6, df = 19, p-value = 0.902

Смещенный кубик - числа от 1 до 10 имеют вероятность 0,045; эти 11-20 имеют вероятность 0,055 - 200 бросков:

rolls <- sample(1:20, 200, replace = T, prob=cbind(rep(0.045,10), rep(0.055,10)))
table(rolls)
#rolls
# 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 
# 8  9  7 12  9  7 14  5 10 12 11 13 14 16  6 10 10  7  9 11 
chisq.test(table(rolls), p = rep(0.05, 20))

#        Chi-squared test for given probabilities
#
# data:  table(rolls) 
# X-squared = 16.2, df = 19, p-value = 0.6439

У нас недостаточно доказательств смещения (р = 0,64).

Предвзятый кубик, 1000 бросков:

rolls <- sample(1:20, 1000, replace = T, prob=cbind(rep(0.045,10), rep(0.055,10)))
table(rolls)
#rolls
# 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 
# 42 47 34 42 47 45 48 43 42 45 52 50 57 57 60 68 49 67 42 63 
chisq.test(table(rolls), p = rep(0.05, 20))

#        Chi-squared test for given probabilities
#
# data:  table(rolls) 
# X-squared = 32.36, df = 19, p-value = 0.02846

Теперь р <0,05, и мы начинаем видеть признаки смещения. Вы можете использовать подобное моделирование для оценки уровня смещения, которое вы можете ожидать, и количества бросков, необходимых для его обнаружения с заданным p-уровнем.

Ничего себе, еще 2 ответа, прежде чем я закончил печатать.

Вы хотите сделать это вручную или в Excel?

Если вы хотите сделать это в R , вы можете сделать это следующим образом:

Шаг 1: бросьте кубик (скажем) 100 раз.

Шаг 2: посчитайте, сколько раз вы получили каждый из ваших номеров

Шаг 3: поместите их в R следующим образом (напишите число раз, когда вы получили бросок кубика вместо чисел, которые я написал):

x <- as.table(c(1,2,3,4,5,6,7,80,9,10,11,12,13,14,15,16,17,18,19,20))

Шаг 4: просто запустите эту команду:

chisq.test(x)

Если значение P низкое (например: ниже 0,05) - ваш кубик не сбалансирован.

Эта команда имитирует симметричный кристалл (P = ~ .5):

chisq.test(table(sample(1:20, 100, T)))

И это симулирует неуравновешенный кубик:

chisq.test(table(c(rep(20,10),sample(1:20, 100, T))))

(Это должно быть около P = ~ .005)

Теперь реальный вопрос заключается в том, сколько кубиков нужно бросить на какой уровень мощности обнаружения. Если кто-то хочет заняться этим, его приветствуют ...

Обновление: Существует также хорошая статья на эту тему здесь .

$n=37$

Во-первых, в соответствии с тем, что сказал @Glen_b, байесианец на самом деле не интересуется, действительно ли кубик абсолютно честен - это не так. Что его волнует, так это то, достаточно ли он близок , что бы ни означало «достаточно» в контексте, скажем, в пределах 5% от справедливости для каждой стороны.

$p_1$$p_2$$p_3$$p=(p_1,p_2,p_3)$$p_1+p_2+p_3=1$$\alpha_0=(1,1,1)$

$X=(X_1,X_2,X_3)$$X$$p=(p_1,p_2,p_3)$$\alpha=(x_1+1,x_2+1,x_3+1)$

$p$

Во всяком случае, вот как (с R):

Во-первых, получить некоторые данные. Мы бросаем кубик 500 раз.

set.seed(1)
y <- rmultinom(1, size = 500, prob = c(1,1,1))

(мы начинаем с честного кубика; на практике эти данные будут соблюдаться.)

$p$

library(MCMCpack)
A <- MCmultinomdirichlet(y, alpha0 = c(1,1,1), mc = 5000)
plot(A)
summary(A)

Наконец, давайте оценим нашу апостериорную вероятность (после наблюдения данных), что матрица находится в пределах 0,05 от справедливой по каждой координате.

B <- as.matrix(A)
f <- function(x) all((x > 0.28)*(x < 0.38))
mean(apply(B, MARGIN = 1, FUN = f))

Результат около 0,9486 на моей машине. (Не удивительно, правда. Мы все-таки начали с честного кубика.)

Быстрое замечание: для нас, вероятно, не имеет смысла использовать неинформативный ранее в этом примере. Поскольку существует даже вопрос, предположительно, что матрица вначале выглядит приблизительно сбалансированной, поэтому может быть лучше выбрать априор, сконцентрированный ближе к 1/3 во всех координатах. Выше это просто сделало бы нашу предполагаемую апостериорную вероятность «близкой к справедливой» еще выше.

Тест на соответствие критерию хи-квадрат направлен на то, чтобы найти все возможные отклонения от строгой однородности. Это разумно с d4 или d6, но с d20 вы, вероятно, больше заинтересованы в проверке того, что вероятность того, что вы выберете (или, возможно, превысите) каждый результат, близка к той, которая должна быть.

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

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

Существуют различные способы проверки «интересных» отклонений (те, которые с большей вероятностью окажут существенное влияние на типичное использование d20)

Моя рекомендация состоит в том, чтобы сделать тест ECDF (тест типа Колмогорова-Смирнова / Андерсона-Дарлинга - но вы, вероятно, захотите отрегулировать консервативность, обусловленную дискретностью распределения - по крайней мере, подняв номинальный альфа-уровень, но даже лучше, просто симулируя распределение, чтобы увидеть, как распределение тестовой статистики идет для d20).

Они по-прежнему могут улавливать любые отклонения, но придают относительно больший вес более важным видам отклонений.

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

В этом ответе я предлагаю графический метод тестирования матрицы, основанный на размерах отдельных отклонений. Как и в тесте хи-квадрат, это больше подходит для игры в кости с несколькими сторонами, такими как d4 или d6.

Если вас интересует просто проверка количества раз, когда появляется каждое число, тогда подойдет критерий хи-квадрат. Предположим, вы бросили кубик N раз. Можно ожидать, что каждое значение возрастет N / 20 раз. Все, что делает тест хи-квадрат, это сравнивает то, что вы наблюдали, с тем, что вы получаете. Если эта разница слишком велика, это указывает на проблему.

Другие тесты

Если вас интересовали другие аспекты случайности, например, если вы играли в кости, выдали следующее:

1, 2, 3, 4...., 20,1,2,..

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

Тест хи-квадрат в R

В R это будет

##Roll 200 times
> rolls = sample(1:20, 200, replace=TRUE)
> chisq.test(table(rolls), p = rep(0.05, 20))
    Chi-squared test for given probabilities
data:  table(rolls) 
X-squared = 16.2, df = 19, p-value = 0.6439

## Too many 1's in the sample
> badrolls = cbind(rolls, rep(1, 10))   
> chisq.test(table(badrolls), p = rep(0.05, 20))

    Chi-squared test for given probabilities

data:  table(badrolls) 
X-squared = 1848.1, df = 19, p-value < 2.2e-16

Возможно, не следует концентрироваться на одном наборе ролей.

Попробуйте бросить шестигранный кубик 10 раз и повторите процесс 8 раз.

> xy <- rmultinom(10, n = N, prob = rep(1, K)/K)
> xy
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    3    1    0    0    1    1    2    1
[2,]    0    0    1    2    1    1    0    1
[3,]    1    3    6    0    1    3    2    4
[4,]    2    1    0    5    2    0    2    1
[5,]    3    2    0    2    1    3    3    0
[6,]    1    3    3    1    4    2    1    3

Вы можете проверить, что сумма для каждой повторной суммы равна 10.

> apply(xy, MARGIN = 2, FUN = sum)
[1] 10 10 10 10 10 10 10 10

Для каждого повтора (по столбцам) вы можете рассчитать степень соответствия, используя критерий Chi ^ 2.

unlist(unname(sapply(apply(xy, MARGIN = 2, FUN = chisq.test), "[", "p.value")))
[1] 0.493373524 0.493373524 0.003491841 0.064663031 0.493373524 0.493373524 0.669182902
[8] 0.235944538

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

K <- 20
N <- 10000

xy <- rmultinom(100, n = N, prob = rep(1, K)/K)
hist(unlist(unname(sapply(apply(xy, MARGIN = 2, FUN = chisq.test), "[", "p.value"))))