d20의 공정성을 어떻게 테스트 할 수 있습니까?


29

20면 다이 (d20)의 공정성을 어떻게 테스트 할 수 있습니까? 분명히 나는 ​​값의 분포를 균일 한 분포와 비교할 것입니다. 대학에서 카이 제곱 테스트를 사용한 것을 막연히 기억합니다. 주사위가 공정한지 확인하기 위해 이것을 어떻게 적용 할 수 있습니까?


나는 d6 (6면 다이)에 대한 테스트에 대해 생각했습니다. 여기에는 테스트에 필요한 롤 수를 찾는 것이 포함되었습니다. 매우 기본이지만 계산하는 데 시간이 오래 걸립니다. localtrainbeplac.bplaced.net/die.php를 살펴 보십시오 .

답변:


15

다음은 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

편견의 증거가 충분하지 않습니다 (p = 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

이제 p <0.05이고 우리는 편견의 증거를보기 시작했습니다. 유사한 시뮬레이션을 사용하여 감지 할 수있는 바이어스 레벨과 주어진 p 레벨로이를 감지하는 데 필요한 스로프 수를 추정 할 수 있습니다.

와우, 입력을 마치기 전에도 2 개의 다른 답변이 있습니다.


모든 대답은 비슷하지만 약간 다릅니다. 나는 그것이 정말로 중요하다고 생각하지 않습니다.
csgillespie

답변 해주셔서 감사합니다. p 값과 거부에 관한 모든 초보자 자료가 포함되어 있기 때문에 이것을 수락했습니다.
C. Ross

10

손으로 또는 엑셀로 하시겠습니까?

당신이 그것을하고 싶은 경우 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가됩니다)

이제 실제 질문은 몇 개의 다이가 어떤 레벨의 검출력으로 굴려 져야 하는가입니다. 누군가가 그 문제를 해결하고 싶다면 환영합니다 ...

업데이트 :이 주제에 대한 좋은 기사도 있습니다 .


5
참고로 +1 : 실제 다이 테스트에 대한 긴 논문입니다. 저자 중반은 KS 테스트 사용을 제안한 다음 공정성에서 특정 형태의 편차를 식별하는 방법으로 진행합니다. 또한 카이-제곱은 면당 적은 수의 롤 (예 : 20면 다이의 100 롤)에 대한 근사치이며 전력이 변하는 등을 잘 알고 있습니다. 알다시피 분명히 알 수 있습니다.
whuber

8

=37

먼저, @Glen_b 한 말과 일치, 베이지안 실제로 다이인지 여부를 관심이 없다 정확하게 공정 - 그것은 아니다. 그가 관심 을 갖는 것은 문맥에서 "충분한"의미가 무엇이든간에, 각 측면에 대해 공정의 5 % 내에서 그것이 충분히 근접했는지 여부 입니다.

12=(1,2,)1+2+=1α0=(1,1,1)

엑스=(엑스1,엑스2,엑스)엑스=(1,2,)α=(엑스1+1,엑스2+1,엑스+1)

어쨌든, 여기에 방법이 있습니다 (R 사용).

먼저 데이터를 얻으십시오. 우리는 주사위를 500 번 굴립니다.

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

(우리는 공정한 주사위로 시작합니다. 실제로 이러한 데이터는 관찰 될 것입니다.)

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에 가깝게 집중되는 사전을 선택하는 것이 좋습니다. 이보다 "공정에 가깝다"는 추정 된 사후 확률을 훨씬 더 높게 만들었을 것입니다.


8

카이 제곱 적합도 검정은 엄격한 균일 성으로부터 가능한 모든 종류의 편차를 찾는 것을 목표로합니다. 이것은 d4 또는 d6에서는 합리적이지만 d20에서는 각 결과가 롤오버 (또는 초과 가능) 할 확률이 예상과 비슷한 지 확인하는 데 더 관심이있을 것입니다.

내가 얻는 것은 d20을 사용하는 모든 것에 크게 영향을 줄 수있는 공평성에서 벗어나는 편차와 전혀 중요하지 않은 다른 종류의 편차가 있다는 것입니다. 덜 흥미로운 대안. 결과는 공정성에서, 심지어 매우 적당한 편차를 데리러 충분한 전력을 가지고 있다는 것입니다, 당신은 필요 거대한 롤의 수를 - 훨씬 더 당신이 이제까지 앉아 생성 할보다.

(힌트 : d20에 대한 몇 가지 비 균일 확률 세트를 생각해보십시오. d20을 사용하는 결과에 가장 큰 영향을 미치며 시뮬레이션 및 카이 제곱 테스트를 사용하여 이에 대한 힘을 알아냅니다. 다양한 롤 수, 필요한 롤 수에 대한 정보를 얻을 수 있습니다.)

"흥미로운"편차를 확인하는 다양한 방법이 있습니다 (d20의 일반적인 사용에 실질적으로 영향을 줄 수있는 방법).

ECDF 테스트 (Kolmogorov-Smirnov / Anderson-Darling-type 테스트)를 수행하는 것이 좋습니다. 그러나 최소한 공칭 알파 수준을 높이면 분포가 불연속적인 결과로 인한 보수성을 조정할 수 있습니다. 테스트 통계의 분포가 d20에 어떻게 적용되는지 확인하기 위해 분포를 시뮬레이션하는 것이 좋습니다.

이것들은 여전히 ​​모든 종류의 편차를 가져올 수 있지만 더 중요한 종류의 편차에 상대적으로 더 많은 가중치를 부여합니다.

보다 강력한 접근 방식은 가장 중요한 대안에 특히 민감한 테스트 통계를 구체적으로 구성하는 것이지만 조금 더 많은 작업이 필요합니다.


이 답변 에서는 개별 편차의 크기에 따라 다이를 테스트하기위한 그래픽 방법을 제안합니다. 카이 제곱 테스트와 마찬가지로 d4 또는 d6과 같은 측면이 적은 주사위에 더 적합합니다.


7

각 숫자가 나타나는 횟수 만 확인하려면 카이 제곱 테스트가 적합합니다. 주사위를 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

0

아마도 한 세트의 롤에 그다지 집중해서는 안됩니다.

6면 다이를 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"))))

여기에 이미지 설명을 입력하십시오

당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.