2つの多項分布の比較

背景：ピザを8つのスライスに切ったところを想像してみてください。

[

スライスの各直線エッジに、反対の極性を外側に向けた磁石を挿入します。これらのコンポーネントを分離して、ひっくり返さないようにして振ると、完全なピザになります。

ここで、追加のスライス（同じサイズ、フルピザの1/8）を入れても、フルピザが常に形成されるとは限りません。4＆5、3＆6、2＆7および1＆8のクラスターを形成できます。

モデル（Hosokawa et al。（1994）により提供）は、各クラスターが形成される確率を示します。モデルを検証するために、いくつかの物理実験を行います。実験条件ごとに20回試行しています。

私の結果は次のようになります：

Cluster  Theoretical  Physical
3,6:    6.01961132827  4  
1,8:    2.77455224377  5  
4,5:    6.62198848501  5  
2,7:    4.58384794294  6  

上記のデータは多項分布です（ダイスを振ったときに得られる分布に似ています）。9つのスライスがある場合、各試行は4つの状態のいずれかで終了できます。

9スライスの実験に加えて、40スライス（およびその他いくつか）の実験のデータも持っています。（ここに含めたい場合はお知らせください）

問題：適合度をテストするために、ピアソンのカイ2乗検定を実行します。ただし、両方の分布の平均は「近い」ため、帰無仮説を棄却できません。ただし、帰無仮説も受け入れられません。

質問：モデルが物理実験にどの程度「近づく」かを示すより良い方法はありますか？「標準偏差」に相当する多項式、またはおそらく信頼区間？信頼区間のある回帰？

更新：私の同僚は、Rでの回帰分析のために次のアプローチを提案しました：

d=read.csv("data.csv")
length(unique(d$abs_state))
nrow(d)
d$n_componentsf=as.factor(d$n_components)

ncomps=9
dsubs=d[d$n_components==ncomps,]
# using exact multinomial test in EMT (better)
library(EMT)
# using Chi square test statistics
EMT::multinomial.test(dsubs$freq_obs, 
                      dsubs$freq_pred/sum(dsubs$freq_pred),
                      useChisq=TRUE,MonteCarlo=FALSE)
# using p value calculated via Monte Carlo approach
EMT::multinomial.test(dsubs$freq_obs, 
                      dsubs$freq_pred/sum(dsubs$freq_pred),
                      ntrial = 100000,
                      MonteCarlo=TRUE)

# other exact multinomial test implementation
library(RVAideMemoire)
RVAideMemoire::multinomial.test(dsubs$freq_obs, 
                                p=dsubs$freq_pred/sum(dsubs$freq_pred))


# if you're interested in 95% confidence limits
# on your multinomial proportions you can 
# calculate these like this
library(DescTools)
MultinomCI(dsubs$freq_obs, conf.level=0.95)

library(ggplot2)
library(lattice)

# if you would like to analyse all data together
# you could also analyse the observed frequency
# counts as having approx Poisson expectation,
# using a Poisson GLM 
# (or a binomial GLM if you put cbind(freq_obs,freq_notobs) as your dependent var and use family=binomial)
library(afex)
library(MASS)
library(car)
library(effects)
set_sum_contrasts() # use effect coding, as data is unbalanced

fit=glm(freq_obs ~ freq_pred, 
        family=quasipoisson, data=d)
summary(fit)
Anova(fit, test="LR", type="III")

plot(allEffects(fit),type="response", rug=F)
plot1=plot(Effect(c("freq_pred"),
            mod=fit),type="response",rug=F)
plot2=xyplot(freq_obs ~ freq_pred,
             data=d,
             type=c("p"),
             par.settings=
               simpleTheme(col=c("blue","red"),pch=16,cex=1.1))
library(latticeExtra)
plot1+plot2 # nice correspondence between observed and expected frequencies

# sticking model predictions in data frame and
# plotting this in ggplot2 instead
df=data.frame(effect(term="freq_pred",
                  mod=fit,
                  xlevels=list(freq_pred=seq(0,15,1)),type="response"))
df

library(ggplot2)
library(ggthemes)
ggplot(data=df) +
  geom_ribbon(data = df, 
              aes(x=freq_pred, ymin=lower, ymax=upper), linetype=2, alpha=0.1) +
  geom_line(data = df, aes(x=freq_pred, y=fit)) +
  geom_point(data = d, aes(x=freq_pred, y=freq_obs, color=n_componentsf), cex=3) +
  ylab("Predicted frequency") + 
  xlab("Observed frequency") +
  theme_few(base_size=16) 

Data.csvには以下が含まれます。

n_components,abs_state,freq_pred,freq_obs,freq_notobs
9,"3,6",6.019611328,4,16
9,"1,8",2.774552244,5,15
9,"4,5",6.621988485,5,15
9,"2,7",4.583847943,6,14
15,"3,6,6",1.81009773,0,20
15,"4,5,6",3.927622683,7,13
15,"7,8",13.49657189,13,7
15,"5,5,5",0.765707695,0,20
40,"4,5,5,5,6,7,8",0.803987454,0,20
40,"5,6,6,7,8,8",3.376961833,3,17
40,"2,7,7,8,8,8",0.230595232,0,20
40,"5,7,7,7,7,7",0.175319358,0,20
40,"5,6,7,7,7,8",2.709196442,1,19
40,"5,5,5,5,6,7,7",0.170797287,0,20
40,"4,5,5,6,6,7,7",0.847746645,1,19
40,"8,8,8,8,8",0.230119576,0,20
40,"4,6,7,7,8,8",1.795116571,0,20
40,"6,6,6,6,8,8",0.483846181,0,20
40,"5,5,5,5,6,6,8",0.185675465,1,19
40,"4,7,7,7,7,8",0.4072505,0,20
40,"5,5,5,6,6,6,7",0.274814936,1,19
40,"5,5,6,8,8,8",0.708881447,1,19
40,"4,6,6,8,8,8",0.479526825,1,19
40,"4,5,5,5,5,8,8",0.071967085,0,20
40,"5,5,7,7,8,8",1.233981848,1,19
40,"4,5,6,6,6,6,7",0.34756786,1,19
40,"6,6,6,7,7,8",2.208449237,2,18
40,"4,5,5,6,6,6,8",0.494611498,1,19
40,"5,5,5,5,5,7,8",0.061650486,0,20
40,"4,5,5,5,5,5,5,6",0.010322162,0,20
40,"3,6,6,6,6,6,7",0.071274376,0,20
40,"4,6,6,6,6,6,6",0.015244456,0,20
40,"6,6,7,7,7,7",0.656508868,1,19
40,"4,5,5,5,7,7,7",0.155256863,2,18
40,"5,5,6,6,6,6,6",0.04917738,0,20
40,"3,6,7,8,8,8",0.634760319,0,20
40,"3,7,7,7,8,8",0.430171526,1,19
40,"5,5,5,5,5,5,5,5",0.00022644,0,20

コードは3つの印象的な[少なくとも私には:)]プロットを作成します。しかし、私は彼らの正しさについて懐疑的です。私が理解していることから、回帰曲線は予測と観測の対応を表しています。この曲線は、対応を考えるとおそらく「最適」です。しかし、対応点の大部分が最初に作成されたことが気になるようです。この懸念は有効ですか？

回帰曲線を参照して、信頼区間はどのように計算されますか？バウアー（1972）の論文を見つけましたが、うまく理解できませんでした。信頼区間がどのように計算されるかを理解するのに役立ちます。

その他の（おそらく初歩的な）質問：-回帰プロットの状態を観察しないことの影響は何ですか？たとえば、15スライスの実験の1番目と4番目の状態は物理的に観察されませんか？-3番目のプロット（Rコードを実行した後に取得）で、軸が反転する特別な理由はありますか？

最後に、プロットからどのような結論を導き出すことができますか？回帰プロットの対応点のほとんどは、信頼区間の外にあります。これは、モデルが予測を行う（できない）ことを確実に示すものですか？

最後に、そして明らかに、データは不十分です。必要な量のデータを見つけるには、信頼区間が望ましい幅に減少するまで、十分な数の試行を行う必要があります（この幅を選択するのは簡単ではないことに気付きました）。予測頻度のランダムな複製を試みました（貧乏人のブートストラップ？）。しかし、もう一度、ピアソンのカイ2乗統計から信頼区間がどのように計算されるのか理解できないという問題に遭遇します。

あなたのデータに最適なテストは、すでに推定した多項式テストだと思います。

期待される分布と観測された分布の差の「尺度」については、カルバックライブラーダイバージェンスを検討してください。最初の実験について：

require(entropy)
cv <- d[1:4,]
set.seed(42)
probs <- cv$freq_pred/20
cv$freq_exp <- table(sample(c(1:4), 10000, prob=probs, replace=T))
KL.empirical(cv$freq_exp, cv$freq_obs)

KL Divergenceは0.072です。0の場合、2番目の分布は1番目の分布と同様です。1の場合、2番目の分布は1番目の分布との関連性が低くなります。情報理論に基づいたより詳細な解釈については、こちらをご覧ください。