Bir d20'nin adaletini nasıl test edebilirim?


29

Yirmi yüzlü bir kalıbın dürüstlüğünü nasıl test edebilirim (d20)? Açıkçası, değerlerin dağılımını tek tip bir dağılıma karşı karşılaştırıyor olacağım. Üniversitede Ki-kare testi kullandığını belli belirsiz hatırlıyorum. Bir ölünün adil olup olmadığını görmek için bunu nasıl uygulayabilirim?


Bir d6 (altı taraflı kalıp) testi hakkında düşündüm. Bu, test etmek için gereken rulo sayısının bulunmasını içerir. Çok basit ama yine de hesaplanması uzun sürüyor. Localtrainbeplac.bplaced.net/die.php adresini ziyaret edin .

Yanıtlar:


15

İşte R kodlu bir örnek. Çıktı önceleri # 'lerden önce gelir. Adil bir ölüm:

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

Önyargılı bir kalıp - 1'den 10'a kadar olan sayıların her birinin 0.045 olasılığı vardır; Bu 11-20 arası 0,055 - 200 atış ihtimaline sahip:

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

Önyargı için yetersiz kanıtımız var (p = 0.64).

Önyargılı bir kalıp, 1000 atar:

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

Şimdi p <0.05 ve önyargı kanıtlarını görmeye başlıyoruz. Belirlemek istediğiniz önyargı seviyesini ve belirli bir p düzeyinde tespit etmek için gereken atış sayısını tahmin etmek için benzer simülasyonları kullanabilirsiniz.

Vay, yazmayı bitirmeden önce bile 2 cevap daha.


Tüm cevaplar benzer, ancak biraz farklı. Bunun gerçekten önemli olduğunu sanmıyorum.
csgillespie

Cevap için teşekkürler. Bunu kabul ettim çünkü p değerleri ve reddetme ile ilgili tüm acemi şeyleri içeriyordu.
C. Ross

10

Elle mi yoksa excel olarak mı yapmak istiyorsun?

Eğer bunu yapmak istiyorsan R , bunu bu şekilde yapabilirsiniz:

1. Adım: 100 kere ölün (diyelim).

2. Adım: numaralarınızın her birini kaç kez aldığınızı sayın

Adım 3: Onları R'ye bu şekilde koyun (yazdığınız sayılar yerine, aldığınız her kalıp rulosunun sayısını yazın):

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. Adım: basitçe bu komutu çalıştırın:

chisq.test(x)

P değeri düşükse (örneğin: feryat 0,05) - kalıbınız dengeli değildir.

Bu komut dengeli bir kalıbı simüle eder (P = ~ .5):

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

Bu da dengesiz bir kalıbı taklit eder:

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

(Yaklaşık P = ~ .005 olur)

Şimdi asıl soru, ne kadar kalıbın hangi algılama gücü seviyesine getirilmesi gerektiğidir. Birisi bunu çözmek istiyorsa, memnuniyetle karşılanır ...

Güncelleme: Burada bu konuda güzel bir yazı da var .


5
Referans için +1: pratik kalıp testiyle ilgili uzun bir inceleme. Yazarın yarısı, bir KS testinin kullanılmasını önermekte ve daha sonra adaletten belirli sapma biçimlerini tanımlamanın yollarına gitmektedir. Ki-kare'nin yüzdeki az sayıda rulo için (örneğin, 20 taraflı bir yüzün 100 rulosu için), gücün değişkenlik gösterdiği vs. gibi bir yaklaşım olduğunu da iyi biliyor. bilmek açıkça ortaya konmuştur.
whuber

8

n=37

Öncelikle, @Glen_b'in söylediğine paralel olarak, bir bayesyen, ölmenin tamamen adil olup olmadığıyla ilgilenmiyor - değil. Onun umursadığı şey, yeterince yakın olup olmadığına , bağlamda "yeterince" ne olursa olsun, yani, her bir taraf için% 5'lik pay dahilinde.

p1p2p3p=(p1,p2,p3)p1+p2+p3=1α0=(1,1,1)

X=(X1,X2,X3)Xp=(p1,p2,p3)α=(x1+1,x2+1,x3+1)

p

Neyse, işte (R ile):

İlk önce biraz veri al. Kalıbı 500 kez yuvarlıyoruz.

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

(Adil bir kalıpla başlıyoruz; pratikte bu veriler gözlenecekti.)

p

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

Son olarak, posterior olasılığımızı (verileri gözlemledikten sonra) her bir koordinatta kalıbın 0.05'in içinde olduğunu tahmin edelim.

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

Sonuç benim makinemde yaklaşık 0.9486. (Sürpriz değil, gerçekten. Ne de olsa adil bir kalıpla başladık.)

Kısa açıklama: Bu örnekte önceden bilgilendirici olmayan bir kişi kullanmamız bizim için mantıklı değil. Muhtemelen bir soru olduğu için, kalıp ilk etapta yaklaşık olarak dengeli görünmektedir, bu nedenle tüm koordinatlarda 1/3 seviyesine daha yakın olan bir öncelik seçmek daha iyi olabilir. Bunun üzerinde tahmin edilen posterior olasılığımızı “fuara yakın” hale getirebilirdik.


8

Ki-kare uygunluk testinin iyiliği, katı bütünlükten olası tüm sapma türlerini bulmayı amaçlar. Bu bir d4 veya d6 ile makul, ancak bir d20 ile muhtemelen her bir sonucun altına girme (veya muhtemelen aşma) ihtimalinin olması gerektiğine yakın olduğunu kontrol etmekle daha fazla ilgileniyorsunuzdur.

Elde ettiğim şey, d20'yi ne kullanıyorsanız kullanın, neredeyse hiç önemli olmayan başka tür sapmalar ve adalet sınavının gücü çok daha ilginç olana bölüştürmesidir. ve daha az ilginç alternatifler. Sonucu adalet bile oldukça ılımlı sapmaları almak için yeterli güce sahip olmak yani, bir ihtiyaç büyük rulo sayısını - çok daha Hiç oturup oluşturmak isteyeyim daha.

(İpucu: d20'niz için d20'yi kullandığınızın sonucunu en çok etkileyecek olan ve bir takım homojen olmayan olasılıklarla karşılaşın ve onlara karşı hangi gücün olduğunu bulmak için simülasyon ve ki-kare testleri kullanın. çeşitli rulo sayıları, böylece ihtiyacınız olacak rulo sayıları hakkında bir fikir edinebilirsiniz.)

"İlginç" sapmaları kontrol etmenin çeşitli yolları vardır (bir d20'nin tipik kullanımlarını büyük ölçüde etkilemesi daha muhtemel olanları)

Benim tavsiyem bir ECDF testi yapmaktır (Kolmogorov-Smirnov / Anderson-Darling-tipi test) - fakat muhtemelen dağılımın ayrık olmasından kaynaklanan muhafazakarlığı ayarlamak isteyeceksiniz - en azından nominal alfa seviyesini yükselterek, hatta Test istatistiğinin dağılımının bir d20 için nasıl gittiğini görmek için dağıtımı simüle ederek daha iyi.

Bunlar hala herhangi bir sapma alabilir, ancak daha önemli sapma türlerine nispeten daha fazla ağırlık koyarlar.

Daha da güçlü bir yaklaşım, özellikle sizin için en önemli alternatiflere özel olarak duyarlı bir test istatistiği oluşturmaktır, ancak biraz daha fazla çalışma gerektirir.


Gelen Bu yanıt tek tek sapmaların boyutuna göre bir kalıp test etmek için grafiksel bir yöntem göstermektedir. Ki-kare testi gibi bu da d4 veya d6 gibi birkaç kenarı olan zarlar için daha mantıklıdır.


7

Her sayının kaç kez göründüğünü kontrol etmekle ilgileniyorsanız, Ki-kare testi uygun olacaktır. Diyelim ki, N kere ölsün. Her değerin N / 20 katına çıkmasını beklersiniz. Ki-kare testlerinin tümü, aldıklarınızla gözlemlediklerinizi karşılaştırıyor. Bu fark çok büyükse, o zaman bu bir problemi gösterir.

Diğer testler

Randonluğun diğer yönleriyle ilgileniyorsanız, örneğin, zar attıysanız, aşağıdaki çıktıları verdi:

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

O zaman bu çıktı her bir değerin doğru sayısına sahip olsa da, açıkça rastgele değildir. Bu durumda, şuna bir bak soruya . Bu muhtemelen sadece elektronik zar için anlamlıdır.

R'de ki-kare testi

R, bu olurdu

##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

Belki bir tane bir rulo setine odaklanmamalıdır.

Bir 6 tarafı yuvarlamayı 10 kez yuvarlamayı deneyin ve işlemi 8 kez tekrarlayın.

> 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

Her tekrar için toplamın 10 olduğunu kontrol edebilirsiniz.

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

Her tekrar için (sütun bilge) Chi ^ 2 testini kullanarak formda kalıcılığını hesaplayabilirsiniz.

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

Ne kadar çok atış yaparsanız, o kadar az önyargılı olursunuz. Bunu çok sayıda yapalım.

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"))))

görüntü tanımını buraya girin

Sitemizi kullandığınızda şunları okuyup anladığınızı kabul etmiş olursunuz: Çerez Politikası ve Gizlilik Politikası.
Licensed under cc by-sa 3.0 with attribution required.