library(tidyverse)
library(broom)
library(gnm)
library(vcd)
補足のノート
パッケージ
クロス表の作成
<- c( 64, 94, 58, 46,
Freq 57, 94, 54, 40,
57, 105, 65, 60,
72, 141, 77, 94,
36, 97, 54, 78,
21, 71, 54, 71)
# byrow = TRUEとすることを忘れずに.
<- matrix(Freq, nrow = 6, ncol = 4, byrow = TRUE) |> as.table()
tab dimnames(tab)
[[1]]
[1] "A" "B" "C" "D" "E" "F"
[[2]]
[1] "A" "B" "C" "D"
dimnames(tab) <- list(SES = LETTERS[1:6],
MHS = c("well", "mild", "modelrate", "impared"))
tab
MHS
SES well mild modelrate impared
A 64 94 58 46
B 57 94 54 40
C 57 105 65 60
D 72 141 77 94
E 36 97 54 78
F 21 71 54 71
集計データの作成
表のデータではなく,各変数の組み合わせとその度数からなるデータを作成する.
度数はまず1行目について数値を並べ(1行1列から1行\(I\)列まで),次に2行目について数値を並べる(2行1列から2行\(I\)列まで).これを
Freq
とする.例として「編者による序文」の親の職業と精神的健康の例で考えてみる.これは\(6\times4\)のクロス表なので,まず1行1列から1行4列までの数字を入力し,次に2行1列から2行4列まで入力する.これを3行目から6行目まで繰り返す.表との対応を考えて適当な改行をいれるのもよい.ただしRは改行を入れても入れなくても,単に数値の列(ベクトル)として扱う.
gl
によって変数を作成する.度数がどの行と列に対応しているのかに注意してほしい.
# 1行1列から1行4列,・・・・,6行1列から6行4列まで順に入力
<- c( 64, 94, 58, 46, 57, 94, 54, 40, 57, 105, 65, 60, 72, 141, 77, 94, 36, 97, 54, 78, 21, 71, 54, 71)
Freq
# 表ようにして入力
<- c( 64, 94, 58, 46,
Freq 57, 94, 54, 40,
57, 105, 65, 60,
72, 141, 77, 94,
36, 97, 54, 78,
21, 71, 54, 71)
- 行カテゴリと列カテゴリの数は\(I\)や\(J\)となっている.
I
を使いたいが,Rの関数にすでに用意されているので別の名前を考える.ここではNI
とNJ
とする.- 例のデータでは,行カテゴリ数\(I = 4\),列カテゴリ数\(J = 5\)である.
<- 4
NI <- 6 NJ
- では,
Freq
に対応する行カテゴリと列カテゴリを並べてみる.先程の入力のルールにしたがうと,行については1行1列から1行4列までの数字を入力しているので1,1,1,1
となり,次に2,2,2,2
となる.これを繰り返し最後は6,6,6,6
となる.列については,1,2,3,4
が6回繰り返される.
<- c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6)
Row <- c(1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4)
Col class(Row)
[1] "numeric"
class(Col)
[1] "numeric"
- 属性が数値になっているので
as.factor
(またはfactor
)で因子(factor)に変換する.
<- as.factor(Row)
Row <- as.factor(Col)
Col class(Row);class(Col)
[1] "factor"
[1] "factor"
Row
[1] 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5 5 6 6 6 6
Levels: 1 2 3 4 5 6
Col
[1] 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4
Levels: 1 2 3 4
- 単純な数値の列を作成したければ
rep
関数が便利である.これは整数(integer)となる.
<- rep(1:4, each = 5)
Row <- rep(1:5, length.out = 20)
Col class(Row)
[1] "integer"
class(Col)
[1] "integer"
<- as.factor(Row)
Row <- as.factor(Col)
Col class(Row)
[1] "factor"
class(Col)
[1] "factor"
Row
[1] 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 4 4 4 4 4
Levels: 1 2 3 4
Col
[1] 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5
Levels: 1 2 3 4 5
gl
はGenerate Factor Levelsという関数で,rep
に似ているが,数値ではなく因子を結果として出力する.- 1から
n
までの数字をぞれぞれk
回繰り返して出力する.
<- gl(n = 6, k = 4)
Row <- gl(n = 4, k = 1, length = 24)
Col class(Row)
[1] "factor"
class(Col)
[1] "factor"
Row
[1] 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5 5 6 6 6 6
Levels: 1 2 3 4 5 6
Col
[1] 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4
Levels: 1 2 3 4
- 以上より,
Freq
,Row
,Col
の3つの変数が作成された.これらからなるデータを作成する.data.frame
とtibble
のどちらでもよいが,tibble
の場合は表示させた後に,データの構造(<dbl> <fct> <fct>
)が表示される.
<- data.frame(Freq, Row, Col)
d d
Freq Row Col
1 64 1 1
2 94 1 2
3 58 1 3
4 46 1 4
5 57 2 1
6 94 2 2
7 54 2 3
8 40 2 4
9 57 3 1
10 105 3 2
11 65 3 3
12 60 3 4
13 72 4 1
14 141 4 2
15 77 4 3
16 94 4 4
17 36 5 1
18 97 5 2
19 54 5 3
20 78 5 4
21 21 6 1
22 71 6 2
23 54 6 3
24 71 6 4
# tibble でもよい
<- tibble(Freq, Row, Col)
d d
# A tibble: 24 × 3
Freq Row Col
<dbl> <fct> <fct>
1 64 1 1
2 94 1 2
3 58 1 3
4 46 1 4
5 57 2 1
6 94 2 2
7 54 2 3
8 40 2 4
9 57 3 1
10 105 3 2
# ℹ 14 more rows
- 以上をまとめると次のようになる.本書のプログラム例では
gl
を使うことが多いのでここで使用方法を覚えておこう.
<- c( 64, 94, 58, 46, 57, 94, 54, 40, 57, 105, 65, 60, 72, 141, 77, 94, 36, 97, 54, 78, 21, 71, 54, 71)
Freq <- 4
NI <- 6
NJ <- gl(n = NI, k = NJ, length = NI * NJ)
Row <- gl(n = NJ, k = 1, length = NI * NJ)
Col <- tibble(Freq, Row, Col)
d d
# A tibble: 24 × 3
Freq Row Col
<dbl> <fct> <fct>
1 64 1 1
2 94 1 2
3 58 1 3
4 46 1 4
5 57 1 5
6 94 1 6
7 54 2 1
8 40 2 2
9 57 2 3
10 105 2 4
# ℹ 14 more rows
GLMとGNMの結果の比較
- glmとgnmでは適合度や係数は同じだが,出力されるものが異なる.
<- glm(Freq ~ Row + Col, data = d, family = poisson)
fit_glm <- gnm(Freq ~ Row + Col, data = d, family = poisson) fit_gnm
通常の出力も少し違う.
fit_glm
Call: glm(formula = Freq ~ Row + Col, family = poisson, data = d)
Coefficients:
(Intercept) Row2 Row3 Row4 Col2 Col3
4.10604 -0.08065 0.22460 -0.16838 0.36930 -0.13588
Col4 Col5 Col6
0.25857 -0.14058 0.27738
Degrees of Freedom: 23 Total (i.e. Null); 15 Residual
Null Deviance: 217.4
Residual Deviance: 112 AIC: 274.2
fit_gnm
Call:
gnm(formula = Freq ~ Row + Col, family = poisson, data = d)
Coefficients:
(Intercept) Row2 Row3 Row4 Col2 Col3
4.10604 -0.08065 0.22460 -0.16838 0.36930 -0.13588
Col4 Col5 Col6
0.25857 -0.14058 0.27738
Deviance: 112.0398
Pearson chi-squared: 102.2928
Residual df: 15
names(fit_glm)
[1] "coefficients" "residuals" "fitted.values"
[4] "effects" "R" "rank"
[7] "qr" "family" "linear.predictors"
[10] "deviance" "aic" "null.deviance"
[13] "iter" "weights" "prior.weights"
[16] "df.residual" "df.null" "y"
[19] "converged" "boundary" "model"
[22] "call" "formula" "terms"
[25] "data" "offset" "control"
[28] "method" "contrasts" "xlevels"
names(fit_gnm)
[1] "call" "formula" "terms" "data"
[5] "eliminate" "ofInterest" "na.action" "xlevels"
[9] "offset" "tolerance" "iterStart" "iterMax"
[13] "coefficients" "residuals" "fitted.values" "rank"
[17] "family" "predictors" "deviance" "aic"
[21] "iter" "weights" "prior.weights" "df.residual"
[25] "y" "converged" "constrain" "constrainTo"
[29] "x" "model"
係数はもちろん同じ.
summary(fit_glm)
Call:
glm(formula = Freq ~ Row + Col, family = poisson, data = d)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 4.10604 0.07692 53.378 < 2e-16 ***
Row2 -0.08065 0.07104 -1.135 0.256237
Row3 0.22460 0.06600 3.403 0.000666 ***
Row4 -0.16838 0.07271 -2.316 0.020573 *
Col2 0.36930 0.08325 4.436 9.17e-06 ***
Col3 -0.13588 0.09377 -1.449 0.147336
Col4 0.25857 0.08522 3.034 0.002413 **
Col5 -0.14058 0.09389 -1.497 0.134314
Col6 0.27738 0.08488 3.268 0.001083 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Null deviance: 217.40 on 23 degrees of freedom
Residual deviance: 112.04 on 15 degrees of freedom
AIC: 274.21
Number of Fisher Scoring iterations: 4
summary(fit_gnm)
Call:
gnm(formula = Freq ~ Row + Col, family = poisson, data = d)
Deviance Residuals:
Min 1Q Median 3Q Max
-5.0571 -0.4520 0.4274 1.1667 3.5712
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 4.10604 0.07692 53.378 < 2e-16 ***
Row2 -0.08065 0.07104 -1.135 0.256237
Row3 0.22460 0.06600 3.403 0.000666 ***
Row4 -0.16838 0.07271 -2.316 0.020573 *
Col2 0.36930 0.08325 4.436 9.17e-06 ***
Col3 -0.13588 0.09377 -1.449 0.147336
Col4 0.25857 0.08522 3.034 0.002413 **
Col5 -0.14058 0.09389 -1.497 0.134314
Col6 0.27738 0.08488 3.268 0.001083 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Residual deviance: 112.04 on 15 degrees of freedom
AIC: 274.21
Number of iterations: 4
tidy(fit_glm)
# A tibble: 9 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 4.11 0.0769 53.4 0
2 Row2 -0.0806 0.0710 -1.14 0.256
3 Row3 0.225 0.0660 3.40 0.000666
4 Row4 -0.168 0.0727 -2.32 0.0206
5 Col2 0.369 0.0833 4.44 0.00000917
6 Col3 -0.136 0.0938 -1.45 0.147
7 Col4 0.259 0.0852 3.03 0.00241
8 Col5 -0.141 0.0939 -1.50 0.134
9 Col6 0.277 0.0849 3.27 0.00108
tidy(fit_gnm)
Warning: The `tidy()` method for objects of class `gnm` is not maintained by the broom team, and is only supported through the `glm` tidier method. Please be cautious in interpreting and reporting broom output.
This warning is displayed once per session.
# A tibble: 9 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 4.11 0.0769 53.4 0
2 Row2 -0.0806 0.0710 -1.14 0.256
3 Row3 0.225 0.0660 3.40 0.000666
4 Row4 -0.168 0.0727 -2.32 0.0206
5 Col2 0.369 0.0833 4.44 0.00000917
6 Col3 -0.136 0.0938 -1.45 0.147
7 Col4 0.259 0.0852 3.03 0.00241
8 Col5 -0.141 0.0939 -1.50 0.134
9 Col6 0.277 0.0849 3.27 0.00108
null.deviance
とdf.null
がgnm
では出力されない.
glance(fit_glm)
# A tibble: 1 × 8
null.deviance df.null logLik AIC BIC deviance df.residual nobs
<dbl> <int> <dbl> <dbl> <dbl> <dbl> <int> <int>
1 217. 23 -128. 274. 285. 112. 15 24
glance(fit_gnm)
# A tibble: 1 × 8
null.deviance df.null logLik AIC BIC deviance df.residual nobs
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <int>
1 NA NA -128. 274. 285. 112. 15 24
- gnmで独立モデルと飽和モデル
<- gnm(Freq ~ Row + Col, data = d, family = poisson)
fit_O <- gnm(Freq ~ Row + Col + Row:Col, data = d, family = poisson) fit_S
- モデルの比較は
anova
で可能.
anova(fit_O, fit_S)
Analysis of Deviance Table
Model 1: Freq ~ Row + Col
Model 2: Freq ~ Row + Col + Row:Col
Resid. Df Resid. Dev Df Deviance
1 15 112.04
2 0 0.00 15 112.04
glance(fit_O)
# A tibble: 1 × 8
null.deviance df.null logLik AIC BIC deviance df.residual nobs
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <int>
1 NA NA -128. 274. 285. 112. 15 24
glance(fit_S)
# A tibble: 1 × 8
null.deviance df.null logLik AIC BIC deviance df.residual nobs
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <int>
1 NA NA -72.1 192. 220. 4.35e-14 0 24
期待度数
- 期待度数を保存すれば期待度数についてのクロス表を作成することができる.飽和モデルの場合は,観測度数のクロス表と一致する.また独立モデルでの期待度数をみると,行によって列の幅が異なっていない(列によって行の幅がことなっていない)ことがわかる.
<- d |> mutate(O_Freq = fit_O$fitted.values,
d S_Freq = fit_S$fitted.values)
|> xtabs(Freq ~ Row + Col, data = _) |> mosaic(shade = TRUE) d
|> xtabs(O_Freq ~ Row + Col, data = _) |> mosaic(shade = TRUE) d
|> xtabs(S_Freq ~ Row + Col, data = _) |> mosaic(shade = TRUE) d
fit_O$fitted.values
の代わりにpredict(fit_O, type = "response")
としても良い.type = "response"
を忘れないようにする.
モザイクプロット
gnm
パッケージには,mentalHealth
が用意されているのでこれを使ってみる.
mentalHealth
count SES MHS
1 64 A well
2 94 A mild
3 58 A moderate
4 46 A impaired
5 57 B well
6 94 B mild
7 54 B moderate
8 40 B impaired
9 57 C well
10 105 C mild
11 65 C moderate
12 60 C impaired
13 72 D well
14 141 D mild
15 77 D moderate
16 94 D impaired
17 36 E well
18 97 E mild
19 54 E moderate
20 78 E impaired
21 21 F well
22 71 F mild
23 54 F moderate
24 71 F impaired
xtabs
は集計データからクロス表を作成する際に用いる.xtabs(度数 ~ 行変数 + 列変数, data = データ名)
とすればよい.mentalHealth
ではcount
が度数を示している.
<- xtabs(count ~ SES + MHS, data = mentalHealth)
tab_mentalHealth tab_mentalHealth
MHS
SES well mild moderate impaired
A 64 94 58 46
B 57 94 54 40
C 57 105 65 60
D 72 141 77 94
E 36 97 54 78
F 21 71 54 71
mosaic
でモザイクプロットを図示.影をつけたければshade = TRUE
とする.
mosaic(tab_mentalHealth,
shade = TRUE)
正規化
- モデル適合度を表示するための関数を準備
<- function(obj) {
model.summary <- obj$deviance - obj$df * 2 # AIC(L2)
aic <- obj$deviance - obj$df * log(sum(obj$y)) #BIC(L2)
bic <-
delta 100 * sum(abs(obj$y - obj$fitted.values)) / (2 * sum(obj$y))
<- 1 - pchisq(obj$deviance, obj$df, lower.tail = F)
p <- deparse(substitute(obj))
Model <- tibble(
result "Model Description" = Model,
"df" = obj$df,
"L2" = obj$deviance,
#"AIC(L2)" = aic,
"BIC" = bic,
"Delta" = delta,
"p" = p
)return(result)
}
- 変数と係数と係数の順番を表示するための関数を準備
# 変数と係数と係数の順番を表示
<- function(model) {
var_num data.frame(var = names(model$coefficients),
estimate = model$coefficients) |>
mutate(estimate = estimate,
number = row_number())
}
- 通常のRCモデルでは行スコアと列スコアが正規化されていない.
- Agresti (2002)
set.seed(1)
## Goodman Row-Column association model fits well (deviance 3.57, df 8)
$MHS <- C(mentalHealth$MHS, treatment)
mentalHealth$SES <- C(mentalHealth$SES, treatment)
mentalHealth
# Independent Model
<- gnm(count ~ SES + MHS,
O family = poisson, data = mentalHealth)
# Independent Modelの結果を利用して,初期値を設定
<- residSVD(O, SES, MHS)
mult1 <- gnm(
RC1 ~ SES + MHS + Mult(1, SES, MHS),
count start = c(coef(O), 1, mult1),
family = poisson,
data = mentalHealth
)
Running main iterations..............
Done
# Estimateには数字があるが,Std. ErrorがNAとなっている.これらのパラメータは識別されていない.
summary(RC1)
Call:
gnm(formula = count ~ SES + MHS + Mult(1, SES, MHS), family = poisson,
data = mentalHealth, start = c(coef(O), 1, mult1))
Deviance Residuals:
Min 1Q Median 3Q Max
-0.87231 -0.30983 0.01026 0.29898 0.87866
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.97986 NA NA NA
SESB -0.06671 NA NA NA
SESC 0.05286 NA NA NA
SESD 0.31721 NA NA NA
SESE -0.13824 NA NA NA
SESF -0.42641 NA NA NA
MHSmild 0.63608 NA NA NA
MHSmoderate 0.11422 NA NA NA
MHSimpaired 0.09713 NA NA NA
Mult(., SES, MHS). 0.56928 NA NA NA
Mult(1, ., MHS).SESA -0.40622 NA NA NA
Mult(1, ., MHS).SESB -0.41074 NA NA NA
Mult(1, ., MHS).SESC -0.03823 NA NA NA
Mult(1, ., MHS).SESD 0.15940 NA NA NA
Mult(1, ., MHS).SESE 0.64757 NA NA NA
Mult(1, ., MHS).SESF 1.04863 NA NA NA
Mult(1, SES, .).MHSwell -0.73506 NA NA NA
Mult(1, SES, .).MHSmild 0.17046 NA NA NA
Mult(1, SES, .).MHSmoderate 0.33387 NA NA NA
Mult(1, SES, .).MHSimpaired 1.08597 NA NA NA
Std. Error is NA where coefficient has been constrained or is unidentified
Residual deviance: 3.5706 on 8 degrees of freedom
AIC: 179.74
Number of iterations: 14
tidy(RC1)
# A tibble: 20 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 3.98 NA NA NA
2 SESB -0.0667 NA NA NA
3 SESC 0.0529 NA NA NA
4 SESD 0.317 NA NA NA
5 SESE -0.138 NA NA NA
6 SESF -0.426 NA NA NA
7 MHSmild 0.636 NA NA NA
8 MHSmoderate 0.114 NA NA NA
9 MHSimpaired 0.0971 NA NA NA
10 Mult(., SES, MHS). 0.569 NA NA NA
11 Mult(1, ., MHS).SESA -0.406 NA NA NA
12 Mult(1, ., MHS).SESB -0.411 NA NA NA
13 Mult(1, ., MHS).SESC -0.0382 NA NA NA
14 Mult(1, ., MHS).SESD 0.159 NA NA NA
15 Mult(1, ., MHS).SESE 0.648 NA NA NA
16 Mult(1, ., MHS).SESF 1.05 NA NA NA
17 Mult(1, SES, .).MHSwell -0.735 NA NA NA
18 Mult(1, SES, .).MHSmild 0.170 NA NA NA
19 Mult(1, SES, .).MHSmoderate 0.334 NA NA NA
20 Mult(1, SES, .).MHSimpaired 1.09 NA NA NA
# 行スコアと列スコアがどこにあるかを取り出す.
var_num(RC1)
var estimate number
(Intercept) (Intercept) 3.97986269 1
SESB SESB -0.06671127 2
SESC SESC 0.05286438 3
SESD SESD 0.31721060 4
SESE SESE -0.13824301 5
SESF SESF -0.42641078 6
MHSmild MHSmild 0.63608165 7
MHSmoderate MHSmoderate 0.11422438 8
MHSimpaired MHSimpaired 0.09712562 9
Mult(., SES, MHS). Mult(., SES, MHS). 0.56928163 10
Mult(1, ., MHS).SESA Mult(1, ., MHS).SESA -0.40622196 11
Mult(1, ., MHS).SESB Mult(1, ., MHS).SESB -0.41074261 12
Mult(1, ., MHS).SESC Mult(1, ., MHS).SESC -0.03823317 13
Mult(1, ., MHS).SESD Mult(1, ., MHS).SESD 0.15940228 14
Mult(1, ., MHS).SESE Mult(1, ., MHS).SESE 0.64756808 15
Mult(1, ., MHS).SESF Mult(1, ., MHS).SESF 1.04862845 16
Mult(1, SES, .).MHSwell Mult(1, SES, .).MHSwell -0.73505533 17
Mult(1, SES, .).MHSmild Mult(1, SES, .).MHSmild 0.17045549 18
Mult(1, SES, .).MHSmoderate Mult(1, SES, .).MHSmoderate 0.33386631 19
Mult(1, SES, .).MHSimpaired Mult(1, SES, .).MHSimpaired 1.08596564 20
# c(11:16,17:20)
# getContrastsによって正規化された推定値とその標準誤差を示す.まずは重み付けのない/単位標準化された解を求める.
<- getContrasts(
mu_unit model = RC1,
set = pickCoef(RC1, "[.]SES"),
ref = "mean",
scaleRef = "mean",
scaleWeights = "unit"
)<- getContrasts(
nu_unit model = RC1,
set = pickCoef(RC1, "[.]MHS"),
ref = "mean",
scaleRef = "mean",
scaleWeights = "unit"
)# 正規化された解を表示
mu_unit
Estimate Std. Error
Mult(1, ., MHS).SESA -0.437796539 0.1127343
Mult(1, ., MHS).SESB -0.441250780 0.1141765
Mult(1, ., MHS).SESC -0.156615493 0.1224095
Mult(1, ., MHS).SESD -0.005601809 0.1126574
Mult(1, ., MHS).SESE 0.367406754 0.1240706
Mult(1, ., MHS).SESF 0.673857866 0.0932365
nu_unit
Estimate Std. Error
Mult(1, SES, .).MHSwell -0.73265426 0.06465622
Mult(1, SES, .).MHSmild -0.03347418 0.10831242
Mult(1, SES, .).MHSmoderate 0.09270166 0.12250921
Mult(1, SES, .).MHSimpaired 0.67342677 0.07862280
# 正規化制約を確認
all.equal(sum(mu_unit$qvframe[, 1]), 0)
[1] TRUE
all.equal(sum(nu_unit$qvframe[, 1]), 0)
[1] TRUE
all.equal(sum(mu_unit$qvframe[, 1] ^ 2), 1)
[1] TRUE
all.equal(sum(nu_unit$qvframe[, 1] ^ 2), 1)
[1] TRUE
# 値の制約
<- c(mu_unit$qvframe[, 1][c(1, 6)], nu_unit$qvframe[, 1][c(1, 4)])
con con
[1] -0.4377965 0.6738579 -0.7326543 0.6734268
<- gnm(
RC1 ~ SES + MHS + Mult(1, SES, MHS),
count constrain = c(11, 16, 17, 20),
constrainTo = con,
start = c(coef(O), NA, mult1),
family = poisson,
data = mentalHealth
)
Initialising
Running start-up iterations..
Running main iterations...........
Done
summary(RC1)
Call:
gnm(formula = count ~ SES + MHS + Mult(1, SES, MHS), constrain = c(11,
16, 17, 20), constrainTo = con, family = poisson, data = mentalHealth,
start = c(coef(O), NA, mult1))
Deviance Residuals:
Min 1Q Median 3Q Max
-0.87231 -0.30983 0.01026 0.29898 0.87866
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.840354 0.100134 38.352 < 2e-16 ***
SESB -0.067262 0.089460 -0.752 0.4521
SESC 0.097655 0.088726 1.101 0.2711
SESD 0.386057 0.087802 4.397 1.10e-05 ***
SESE -0.009979 0.110426 -0.090 0.9280
SESF -0.249331 0.133563 -1.867 0.0619 .
MHSmild 0.722031 0.096153 7.509 5.95e-14 ***
MHSmoderate 0.215685 0.108885 1.981 0.0476 *
MHSimpaired 0.269974 0.148273 1.821 0.0686 .
Mult(., SES, MHS). 0.964896 0.191615 5.036 4.76e-07 ***
Mult(1, ., MHS).SESA -0.437797 NA NA NA
Mult(1, ., MHS).SESB -0.441251 0.201840 -2.186 0.0288 *
Mult(1, ., MHS).SESC -0.156615 0.176666 -0.887 0.3753
Mult(1, ., MHS).SESD -0.005602 0.160260 -0.035 0.9721
Mult(1, ., MHS).SESE 0.367407 0.191566 1.918 0.0551 .
Mult(1, ., MHS).SESF 0.673858 NA NA NA
Mult(1, SES, .).MHSwell -0.732654 NA NA NA
Mult(1, SES, .).MHSmild -0.033474 0.159023 -0.210 0.8333
Mult(1, SES, .).MHSmoderate 0.092701 0.180220 0.514 0.6070
Mult(1, SES, .).MHSimpaired 0.673427 NA NA NA
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Std. Error is NA where coefficient has been constrained or is unidentified
Residual deviance: 3.5706 on 8 degrees of freedom
AIC: 179.74
Number of iterations: 11
# intrinsic association parameter
<- summary(RC1)$coefficients["Mult(., SES, MHS).", 1]
phi <- (-1 + sqrt(1 + 4 * phi ^ 2)) / (2 * phi)
rho <- (2 * phi) ^ (-1)
eta <- (1 + eta ^ 2) ^ (1 / 2) - eta
tau list(phi, rho, eta, tau)
[[1]]
[1] 0.9648955
[[2]]
[1] 0.6080959
[[3]]
[1] 0.5181908
[[4]]
[1] 0.6080959
all.equal(rho, tau)
[1] TRUE
## Marginal weighted solution
<- with(mentalHealth, tapply(count, SES, sum) / sum(count))
rowProbs <- with(mentalHealth, tapply(count, MHS, sum) / sum(count))
colProbs <- getContrasts(
mu model = RC1,
set = pickCoef(RC1, "[.]SES"),
ref = rowProbs,
scaleRef = rowProbs,
scaleWeights = rowProbs
)<- getContrasts(
nu model = RC1,
set = pickCoef(RC1, "[.]MHS"),
ref = colProbs,
scaleRef = colProbs,
scaleWeights = colProbs
)<- c(mu$qvframe[, 1][c(1, 6)], nu$qvframe[, 1][c(1, 4)])
con mu
Estimate Std. Error
Mult(1, ., MHS).SESA -1.11233083 0.2990944
Mult(1, ., MHS).SESB -1.12143703 0.3138906
Mult(1, ., MHS).SESC -0.37107606 0.3194546
Mult(1, ., MHS).SESD 0.02702925 0.2734878
Mult(1, ., MHS).SESE 1.01036135 0.3149487
Mult(1, ., MHS).SESF 1.81823312 0.2824636
nu
Estimate Std. Error
Mult(1, SES, .).MHSwell -1.6775144 0.1941179
Mult(1, SES, .).MHSmild -0.1403989 0.2002803
Mult(1, SES, .).MHSmoderate 0.1369925 0.2799954
Mult(1, SES, .).MHSimpaired 1.4136909 0.1724133
con
[1] -1.112331 1.818233 -1.677514 1.413691
# 正規化制約を確認
all.equal(sum(mu$qvframe[, 1] * rowProbs), 0)
[1] TRUE
all.equal(sum(nu$qvframe[, 1] * colProbs), 0)
[1] TRUE
all.equal(sum(mu$qvframe[, 1] ^ 2 * rowProbs), 1)
[1] TRUE
all.equal(sum(nu$qvframe[, 1] ^ 2 * colProbs), 1)
[1] TRUE
<- gnm(
RC1 ~ SES + MHS + Mult(1, SES, MHS),
count constrain = c(11, 16, 17, 20),
constrainTo = con,
start = c(coef(O), NA, mult1),
family = poisson,
data = mentalHealth,
tolerance = 1e-12
)
Initialising
Running start-up iterations..
Running main iterations....................................
Done
summary(RC1)
Call:
gnm(formula = count ~ SES + MHS + Mult(1, SES, MHS), constrain = c(11,
16, 17, 20), constrainTo = con, family = poisson, data = mentalHealth,
start = c(coef(O), NA, mult1), tolerance = 1e-12)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.87231 -0.30982 0.01026 0.29898 0.87866
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.83919 0.10014 38.338 < 2e-16 ***
SESB -0.06736 0.09033 -0.746 0.4558
SESC 0.10590 0.08929 1.186 0.2356
SESD 0.39873 0.08826 4.517 6.26e-06 ***
SESE 0.01363 0.11020 0.124 0.9016
SESF -0.21674 0.13232 -1.638 0.1014
MHSmild 0.71134 0.09556 7.444 9.77e-14 ***
MHSmoderate 0.20306 0.10841 1.873 0.0611 .
MHSimpaired 0.24846 0.14842 1.674 0.0941 .
Mult(., SES, MHS). 0.16649 0.03306 5.036 4.76e-07 ***
Mult(1, ., MHS).SESA -1.11233 NA NA NA
Mult(1, ., MHS).SESB -1.12144 0.53209 -2.108 0.0351 *
Mult(1, ., MHS).SESC -0.37108 0.46573 -0.797 0.4256
Mult(1, ., MHS).SESD 0.02703 0.42248 0.064 0.9490
Mult(1, ., MHS).SESE 1.01036 0.50501 2.001 0.0454 *
Mult(1, ., MHS).SESF 1.81823 NA NA NA
Mult(1, SES, .).MHSwell -1.67751 NA NA NA
Mult(1, SES, .).MHSmild -0.14040 0.34961 -0.402 0.6880
Mult(1, SES, .).MHSmoderate 0.13699 0.39621 0.346 0.7295
Mult(1, SES, .).MHSimpaired 1.41369 NA NA NA
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Std. Error is NA where coefficient has been constrained or is unidentified
Residual deviance: 3.5706 on 8 degrees of freedom
AIC: 179.74
Number of iterations: 36
tidy(RC1)
# A tibble: 20 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 3.84 0.100 38.3 0
2 SESB -0.0674 0.0903 -0.746 4.56e- 1
3 SESC 0.106 0.0893 1.19 2.36e- 1
4 SESD 0.399 0.0883 4.52 6.26e- 6
5 SESE 0.0136 0.110 0.124 9.02e- 1
6 SESF -0.217 0.132 -1.64 1.01e- 1
7 MHSmild 0.711 0.0956 7.44 9.77e-14
8 MHSmoderate 0.203 0.108 1.87 6.11e- 2
9 MHSimpaired 0.248 0.148 1.67 9.41e- 2
10 Mult(., SES, MHS). 0.166 0.0331 5.04 4.76e- 7
11 Mult(1, ., MHS).SESA -1.11 NA NA NA
12 Mult(1, ., MHS).SESB -1.12 0.532 -2.11 3.51e- 2
13 Mult(1, ., MHS).SESC -0.371 0.466 -0.797 4.26e- 1
14 Mult(1, ., MHS).SESD 0.0270 0.422 0.0640 9.49e- 1
15 Mult(1, ., MHS).SESE 1.01 0.505 2.00 4.54e- 2
16 Mult(1, ., MHS).SESF 1.82 NA NA NA
17 Mult(1, SES, .).MHSwell -1.68 NA NA NA
18 Mult(1, SES, .).MHSmild -0.140 0.350 -0.402 6.88e- 1
19 Mult(1, SES, .).MHSmoderate 0.137 0.396 0.346 7.30e- 1
20 Mult(1, SES, .).MHSimpaired 1.41 NA NA NA
初期値
# データの準備
<- c( 39, 50, 18, 4,
Freq 140,178, 85, 23,
108,195, 97, 23,
238,598,363,111,
78,250,150, 55,
50,200,208, 74,
8, 29, 46, 21)
.3A <-
tab_2matrix(Freq,
nrow = 7,
ncol = 4,
byrow = TRUE) |> as.table()
<- gl(n = 7, k = 4)
polviews <- gl(n = 4, k = 1, length = 28)
fefam .3A <- tibble(Freq, polviews, fefam)
freq_tab_2.3A freq_tab_2
# A tibble: 28 × 3
Freq polviews fefam
<dbl> <fct> <fct>
1 39 1 1
2 50 1 2
3 18 1 3
4 4 1 4
5 140 2 1
6 178 2 2
7 85 2 3
8 23 2 4
9 108 3 1
10 195 3 2
# ℹ 18 more rows
# 独立モデル
<- freq_tab_2.3A |> gnm(
O ~ polviews + fefam,
Freq family = poisson,
data = _,
tolerance = 1e-12
)
var_num(O)
var estimate number
(Intercept) (Intercept) 3.0603480 1
polviews2 polviews2 1.3449091 2
polviews3 polviews3 1.3378420 3
polviews4 polviews4 2.4682522 4
polviews5 polviews5 1.5689912 5
polviews6 polviews6 1.5671133 6
polviews7 polviews7 -0.0651393 7
fefam2 fefam2 0.8194665 8
fefam3 fefam3 0.3804447 9
fefam4 fefam4 -0.7539609 10
<- freq_tab_2.3A |>
RC gnm(
~ polviews + fefam +
Freq Mult(1, polviews, fefam),
family = poisson,
data = _,
tolerance = 1e-12
)
Initialising
Running start-up iterations..
Running main iterations............................
Done
var_num(RC)
var estimate number
(Intercept) (Intercept) 2.902702351 1
polviews2 polviews2 1.390548385 2
polviews3 polviews3 1.427149259 3
polviews4 polviews4 2.586614669 4
polviews5 polviews5 1.686005670 5
polviews6 polviews6 1.625948840 6
polviews7 polviews7 -0.114101970 7
fefam2 fefam2 0.889280567 8
fefam3 fefam3 0.414411068 9
fefam4 fefam4 -0.767263370 10
Mult(., polviews, fefam). Mult(., polviews, fefam). 0.354847803 11
Mult(1, ., fefam).polviews1 Mult(1, ., fefam).polviews1 -4.642973707 12
Mult(1, ., fefam).polviews2 Mult(1, ., fefam).polviews2 -3.587221083 13
Mult(1, ., fefam).polviews3 Mult(1, ., fefam).polviews3 -2.177313145 14
Mult(1, ., fefam).polviews4 Mult(1, ., fefam).polviews4 -0.001967735 15
Mult(1, ., fefam).polviews5 Mult(1, ., fefam).polviews5 0.933577004 16
Mult(1, ., fefam).polviews6 Mult(1, ., fefam).polviews6 3.992993578 17
Mult(1, ., fefam).polviews7 Mult(1, ., fefam).polviews7 6.608154586 18
Mult(1, polviews, .).fefam1 Mult(1, polviews, .).fefam1 -0.468986131 19
Mult(1, polviews, .).fefam2 Mult(1, polviews, .).fefam2 -0.061831609 20
Mult(1, polviews, .).fefam3 Mult(1, polviews, .).fefam3 0.255547101 21
Mult(1, polviews, .).fefam4 Mult(1, polviews, .).fefam4 0.406103105 22
<- residSVD(O, polviews, fefam)
mult1 <- residSVD(O, polviews, fefam, d = 2)
mult2 <- residSVD(O, polviews, fefam, d = 3)
mult3
<- freq_tab_2.3A |>
RC gnm(
~ polviews + fefam + Mult(1, polviews, fefam),
Freq start = c(coef(O), NA, mult1),
family = poisson,
data = _,
tolerance = 1e-12
)
Initialising
Running start-up iterations..
Running main iterations...........................
Done
summary(RC)
Call:
gnm(formula = Freq ~ polviews + fefam + Mult(1, polviews, fefam),
family = poisson, data = freq_tab_2.3A, start = c(coef(O),
NA, mult1), tolerance = 1e-12)
Deviance Residuals:
Min 1Q Median 3Q Max
-1.07428 -0.27239 0.03038 0.36792 1.03721
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.97067 NA NA NA
polviews2 1.38106 NA NA NA
polviews3 1.40499 NA NA NA
polviews4 2.54490 NA NA NA
polviews5 1.63588 NA NA NA
polviews6 1.54832 NA NA NA
polviews7 -0.21523 NA NA NA
fefam2 0.86521 NA NA NA
fefam3 0.37157 NA NA NA
fefam4 -0.81900 NA NA NA
Mult(., polviews, fefam). 0.11476 NA NA NA
Mult(1, ., fefam).polviews1 -2.23657 NA NA NA
Mult(1, ., fefam).polviews2 -1.70908 NA NA NA
Mult(1, ., fefam).polviews3 -1.00463 NA NA NA
Mult(1, ., fefam).polviews4 0.08226 NA NA NA
Mult(1, ., fefam).polviews5 0.54970 NA NA NA
Mult(1, ., fefam).polviews6 2.07831 NA NA NA
Mult(1, ., fefam).polviews7 3.38495 NA NA NA
Mult(1, polviews, .).fefam1 -2.74560 NA NA NA
Mult(1, polviews, .).fefam2 -0.22589 NA NA NA
Mult(1, polviews, .).fefam3 1.73823 NA NA NA
Mult(1, polviews, .).fefam4 2.66996 NA NA NA
Std. Error is NA where coefficient has been constrained or is unidentified
Residual deviance: 8.0718 on 10 degrees of freedom
AIC: 215.43
Number of iterations: 27
tidy(RC)
# A tibble: 22 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 2.97 NA NA NA
2 polviews2 1.38 NA NA NA
3 polviews3 1.40 NA NA NA
4 polviews4 2.54 NA NA NA
5 polviews5 1.64 NA NA NA
6 polviews6 1.55 NA NA NA
7 polviews7 -0.215 NA NA NA
8 fefam2 0.865 NA NA NA
9 fefam3 0.372 NA NA NA
10 fefam4 -0.819 NA NA NA
# ℹ 12 more rows
glance(RC)
# A tibble: 1 × 8
null.deviance df.null logLik AIC BIC deviance df.residual nobs
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <int>
1 NA NA -89.7 215. 239. 8.07 10 28
<- freq_tab_2.3A |>
RC2 gnm(
~ polviews + fefam +
Freq Mult(1, polviews, fefam, inst = 1) +
Mult(1, polviews, fefam, inst = 2),
start = c(coef(O), NA, mult2[, 1], NA, mult2[, 2]),
family = poisson,
data = _,
tolerance = 1e-12
)
Initialising
Running start-up iterations..
Running main iterations.........................................................
..............
Done
summary(RC2)
Call:
gnm(formula = Freq ~ polviews + fefam + Mult(1, polviews, fefam,
inst = 1) + Mult(1, polviews, fefam, inst = 2), family = poisson,
data = freq_tab_2.3A, start = c(coef(O), NA, mult2[, 1],
NA, mult2[, 2]), tolerance = 1e-12)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.500439 -0.068726 -0.002705 0.066147 0.535693
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.993287 NA NA NA
polviews2 1.436412 NA NA NA
polviews3 1.398908 NA NA NA
polviews4 2.518065 NA NA NA
polviews5 1.564082 NA NA NA
polviews6 1.534299 NA NA NA
polviews7 -0.133562 NA NA NA
fefam2 0.814972 NA NA NA
fefam3 0.369393 NA NA NA
fefam4 -0.825633 NA NA NA
Mult(., polviews, fefam, inst = 1). 0.111566 NA NA NA
Mult(1, ., fefam, inst = 1).polviews1 -2.370011 NA NA NA
Mult(1, ., fefam, inst = 1).polviews2 -1.718197 NA NA NA
Mult(1, ., fefam, inst = 1).polviews3 -1.055282 NA NA NA
Mult(1, ., fefam, inst = 1).polviews4 0.094489 NA NA NA
Mult(1, ., fefam, inst = 1).polviews5 0.651356 NA NA NA
Mult(1, ., fefam, inst = 1).polviews6 2.082776 NA NA NA
Mult(1, ., fefam, inst = 1).polviews7 3.020457 NA NA NA
Mult(1, polviews, ., inst = 1).fefam1 -2.548941 NA NA NA
Mult(1, polviews, ., inst = 1).fefam2 -0.333340 NA NA NA
Mult(1, polviews, ., inst = 1).fefam3 1.824525 NA NA NA
Mult(1, polviews, ., inst = 1).fefam4 2.789907 NA NA NA
Mult(., polviews, fefam, inst = 2). 0.064972 NA NA NA
Mult(1, ., fefam, inst = 2).polviews1 -0.129058 NA NA NA
Mult(1, ., fefam, inst = 2).polviews2 1.061518 NA NA NA
Mult(1, ., fefam, inst = 2).polviews3 -0.214994 NA NA NA
Mult(1, ., fefam, inst = 2).polviews4 -0.595091 NA NA NA
Mult(1, ., fefam, inst = 2).polviews5 -1.469833 NA NA NA
Mult(1, ., fefam, inst = 2).polviews6 -0.267529 NA NA NA
Mult(1, ., fefam, inst = 2).polviews7 1.608264 NA NA NA
Mult(1, polviews, ., inst = 2).fefam1 0.298457 NA NA NA
Mult(1, polviews, ., inst = 2).fefam2 -1.828478 NA NA NA
Mult(1, polviews, ., inst = 2).fefam3 0.195655 NA NA NA
Mult(1, polviews, ., inst = 2).fefam4 0.002679 NA NA NA
Std. Error is NA where coefficient has been constrained or is unidentified
Residual deviance: 1.3691 on 4 degrees of freedom
AIC: 220.72
Number of iterations: 71
tidy(RC2)
# A tibble: 34 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 2.99 NA NA NA
2 polviews2 1.44 NA NA NA
3 polviews3 1.40 NA NA NA
4 polviews4 2.52 NA NA NA
5 polviews5 1.56 NA NA NA
6 polviews6 1.53 NA NA NA
7 polviews7 -0.134 NA NA NA
8 fefam2 0.815 NA NA NA
9 fefam3 0.369 NA NA NA
10 fefam4 -0.826 NA NA NA
# ℹ 24 more rows
glance(RC2)
# A tibble: 1 × 8
null.deviance df.null logLik AIC BIC deviance df.residual nobs
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <int>
1 NA NA -86.4 221. 253. 1.37 4 28
<- freq_tab_2.3A |>
RC3 gnm(
~ polviews + fefam + Mult(1, polviews, fefam, inst = 1) +
Freq Mult(1, polviews, fefam, inst = 2) +
Mult(1, polviews, fefam, inst = 3),
start = c(coef(O), NA, mult3[, 1], NA, mult3[, 2], NA, mult3[, 3]),
family = poisson,
data = _,
tolerance = 1e-12
)
Initialising
Running start-up iterations..
Running main iterations......
Done
summary(RC3)
Call:
gnm(formula = Freq ~ polviews + fefam + Mult(1, polviews, fefam,
inst = 1) + Mult(1, polviews, fefam, inst = 2) + Mult(1,
polviews, fefam, inst = 3), family = poisson, data = freq_tab_2.3A,
start = c(coef(O), NA, mult3[, 1], NA, mult3[, 2], NA, mult3[,
3]), tolerance = 1e-12)
Deviance Residuals:
Min 1Q Median 3Q Max
0 0 0 0 0
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.98832 NA NA NA
polviews2 1.45668 NA NA NA
polviews3 1.38302 NA NA NA
polviews4 2.52059 NA NA NA
polviews5 1.58491 NA NA NA
polviews6 1.51818 NA NA NA
polviews7 -0.10812 NA NA NA
fefam2 0.81254 NA NA NA
fefam3 0.35325 NA NA NA
fefam4 -0.80539 NA NA NA
Mult(., polviews, fefam, inst = 1). 0.11105 NA NA NA
Mult(1, ., fefam, inst = 1).polviews1 -2.36488 NA NA NA
Mult(1, ., fefam, inst = 1).polviews2 -1.70985 NA NA NA
Mult(1, ., fefam, inst = 1).polviews3 -1.02644 NA NA NA
Mult(1, ., fefam, inst = 1).polviews4 0.10832 NA NA NA
Mult(1, ., fefam, inst = 1).polviews5 0.61151 NA NA NA
Mult(1, ., fefam, inst = 1).polviews6 2.15910 NA NA NA
Mult(1, ., fefam, inst = 1).polviews7 2.95936 NA NA NA
Mult(1, polviews, ., inst = 1).fefam1 -2.41740 NA NA NA
Mult(1, polviews, ., inst = 1).fefam2 -0.28415 NA NA NA
Mult(1, polviews, ., inst = 1).fefam3 2.05381 NA NA NA
Mult(1, polviews, ., inst = 1).fefam4 2.43636 NA NA NA
Mult(., polviews, fefam, inst = 2). 0.06452 NA NA NA
Mult(1, ., fefam, inst = 2).polviews1 -0.12647 NA NA NA
Mult(1, ., fefam, inst = 2).polviews2 1.13121 NA NA NA
Mult(1, ., fefam, inst = 2).polviews3 -0.29985 NA NA NA
Mult(1, ., fefam, inst = 2).polviews4 -0.60482 NA NA NA
Mult(1, ., fefam, inst = 2).polviews5 -1.37958 NA NA NA
Mult(1, ., fefam, inst = 2).polviews6 -0.41755 NA NA NA
Mult(1, ., fefam, inst = 2).polviews7 1.74634 NA NA NA
Mult(1, polviews, ., inst = 2).fefam1 0.38993 NA NA NA
Mult(1, polviews, ., inst = 2).fefam2 -1.83914 NA NA NA
Mult(1, polviews, ., inst = 2).fefam3 0.21225 NA NA NA
Mult(1, polviews, ., inst = 2).fefam4 -0.11423 NA NA NA
Mult(., polviews, fefam, inst = 3). 0.05616 NA NA NA
Mult(1, ., fefam, inst = 3).polviews1 2.23238 NA NA NA
Mult(1, ., fefam, inst = 3).polviews2 0.46917 NA NA NA
Mult(1, ., fefam, inst = 3).polviews3 2.19320 NA NA NA
Mult(1, ., fefam, inst = 3).polviews4 0.39281 NA NA NA
Mult(1, ., fefam, inst = 3).polviews5 -0.90419 NA NA NA
Mult(1, ., fefam, inst = 3).polviews6 -0.22218 NA NA NA
Mult(1, ., fefam, inst = 3).polviews7 -2.57455 NA NA NA
Mult(1, polviews, ., inst = 3).fefam1 0.34732 NA NA NA
Mult(1, polviews, ., inst = 3).fefam2 0.17172 NA NA NA
Mult(1, polviews, ., inst = 3).fefam3 0.71728 NA NA NA
Mult(1, polviews, ., inst = 3).fefam4 -1.25788 NA NA NA
Std. Error is NA where coefficient has been constrained or is unidentified
Residual deviance: 2.1316e-14 on 0 degrees of freedom
AIC: 227.35
Number of iterations: 6
tidy(RC3)
# A tibble: 46 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 2.99 NA NA NA
2 polviews2 1.46 NA NA NA
3 polviews3 1.38 NA NA NA
4 polviews4 2.52 NA NA NA
5 polviews5 1.58 NA NA NA
6 polviews6 1.52 NA NA NA
7 polviews7 -0.108 NA NA NA
8 fefam2 0.813 NA NA NA
9 fefam3 0.353 NA NA NA
10 fefam4 -0.805 NA NA NA
# ℹ 36 more rows
glance(RC3)
# A tibble: 1 × 8
null.deviance df.null logLik AIC BIC deviance df.residual nobs
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <int>
1 NA NA -85.7 227. 265. 2.13e-14 0 28
library(logmult)
Attaching package: 'logmult'
The following object is masked from 'package:vcd':
assoc
The following object is masked from 'package:gnm':
se
<- anoas(tab_2.3A, nd = 3) anoas_model
Fitting independence model...
Fitting model with 1 dimension...
Initialising
Running start-up iterations..
Running main iterations........
Done
Fitting model with 2 dimensions...
Initialising
Running start-up iterations..
Running main iterations...............................
Done
Fitting model with 3 dimensions...
Initialising
Running start-up iterations..
Running main iterations...
Done
anoas_model
Res. Df Res. Dev Dev./Indep. (%) Dissim. (%)
Indep. 18 211.69508974175693 100.00000000000000 8.0917102896466
RC(1) 10 8.07181892814987 3.81294575041705 1.7673079267546
RC(2) 4 1.36909098846090 0.64672779615769 0.4963921430961
RC(3) 0 0.00000000000009 0.00000000000004 0.0000000000002
BIC AIC Dev. Df
Indep. 65.12224155397615 175.69508974175693 NA NA
RC(1) -73.35754117617279 -11.92818107185013 -204 -8
RC(2) -31.20265305326816 -6.63090901153910 -7 -6
RC(3) 0.00000000000009 0.00000000000009 -1 -4
rc(tab_2.3A, nd = 1)
Initialising
Running start-up iterations..
Running main iterations............
Done
Call:
rc(tab = tab_2.3A, nd = 1)
Intrinsic association coefficients:
Dim1
0.257
Normalized row scores (Rows):
A B C D E F G
1.8206 1.4153 0.8741 0.0389 -0.3202 -1.4947 -2.4987
Normalized column scores (Columns):
A B C D
1.658 0.192 -0.951 -1.493
Normalization weights: marginal
Deviance: 8.071819
Pearson chi-squared: 8.168769
Dissimilarity index: 1.767308%
Residual df: 10
BIC: -73.35754
AIC: -11.92818
rc(tab_2.3A, nd = 2)
Initialising
Running start-up iterations..
Running main iterations............................
Done
Call:
rc(tab = tab_2.3A, nd = 2)
Intrinsic association coefficients:
Dim1 Dim2
0.245 0.048
Normalized row scores (Rows):
Dim1 Dim2
A 1.9332 0.1608
B 1.3846 -1.5665
C 0.9161 0.0381
D 0.0375 0.3428
E -0.3632 1.4237
F -1.5171 -0.4611
G -2.3120 -3.1663
Normalized column scores (Columns):
Dim1 Dim2
A 1.625 -1.205
B 0.220 1.114
C -0.958 -0.751
D -1.536 -0.480
Normalization weights: marginal
Deviance: 1.369091
Pearson chi-squared: 1.369503
Dissimilarity index: 0.4963921%
Residual df: 4
BIC: -31.20265
AIC: -6.630909
rc(tab_2.3A, nd = 3)
Initialising
Running start-up iterations..
Running main iterations......
Done
Call:
rc(tab = tab_2.3A, nd = 3)
Intrinsic association coefficients:
Dim1 Dim2 Dim3
0.2455 0.0485 0.0204
Normalized row scores (Rows):
Dim1 Dim2 Dim3
A 1.9417 0.1575 0.6432
B 1.3708 -1.5534 -1.0724
C 0.9319 0.0444 1.6635
D 0.0365 0.3379 0.0661
E -0.3566 1.3877 -1.4225
F -1.5358 -0.3972 0.9283
G -2.2540 -3.3219 -1.3514
Normalized column scores (Columns):
Dim1 Dim2 Dim3
A 1.6240 -1.2103 -0.3173
B 0.2205 1.1151 0.0269
C -0.9567 -0.7330 1.0506
D -1.5401 -0.5267 -2.7219
Normalization weights: marginal
Deviance: -4.507505e-14
Pearson chi-squared: 2.138457e-27
Dissimilarity index: 3.201213e-14%
Residual df: 0
BIC: -4.507505e-14
AIC: -4.507505e-14
bind_rows(model.summary(O),
model.summary(RC),
model.summary(RC2),
model.summary(RC3))
# A tibble: 4 × 6
`Model Description` df L2 BIC Delta p
<chr> <int> <dbl> <dbl> <dbl> <dbl>
1 O 18 2.12e+ 2 6.51e+ 1 8.09e+ 0 1
2 RC 10 8.07e+ 0 -7.34e+ 1 1.77e+ 0 0.378
3 RC2 4 1.37e+ 0 -3.12e+ 1 4.96e- 1 0.150
4 RC3 0 2.13e-14 2.13e-14 3.29e-14 1
## 表2.3B
<- c(518, 95, 6, 35, 5,
Freq 81, 67, 4, 49, 2,
452,1003,67,630, 5,
71, 157,37,562,12)
# データを表形式に変換
.3B <-
tab_2matrix(Freq,
nrow = 4,
ncol = 5,
byrow = TRUE) |> as.table()
.3B tab_2
A B C D E
A 518 95 6 35 5
B 81 67 4 49 2
C 452 1003 67 630 5
D 71 157 37 562 12
# 度数,行変数,列変数からなる集計データを作成
<- gl(n = 4, k = 5)
Educ <- gl(n = 5, k = 1, length = 20)
Occ .3B <- tibble(Freq, Educ, Occ)
freq_tab_2.3B freq_tab_2
# A tibble: 20 × 3
Freq Educ Occ
<dbl> <fct> <fct>
1 518 1 1
2 95 1 2
3 6 1 3
4 35 1 4
5 5 1 5
6 81 2 1
7 67 2 2
8 4 2 3
9 49 2 4
10 2 2 5
11 452 3 1
12 1003 3 2
13 67 3 3
14 630 3 4
15 5 3 5
16 71 4 1
17 157 4 2
18 37 4 3
19 562 4 4
20 12 4 5
<- freq_tab_2.3B |>
O gnm(Freq ~ Educ + Occ,
family = poisson,
data = _,
tolerance = 1e-12)
<- residSVD(O, Educ, Occ)
mult1 <- residSVD(O, Educ, Occ, d = 2)
mult2 <- residSVD(O, Educ, Occ, d = 3)
mult3
<- freq_tab_2.3B |>
RC gnm(
~ Educ + Occ + Mult(1, Educ, Occ),
Freq family = poisson,
data = _,
tolerance = 1e-12
)
Initialising
Running start-up iterations..
Running main iterations.........................................................
..................
Done
var_num(RC)
var estimate number
(Intercept) (Intercept) 4.84609319 1
Educ2 Educ2 -0.84036732 2
Educ3 Educ3 1.43223229 3
Educ4 Educ4 -0.20620288 4
Occ2 Occ2 0.48596765 5
Occ3 Occ3 -2.07003164 6
Occ4 Occ4 0.17468852 7
Occ5 Occ5 -3.56888992 8
Mult(., Educ, Occ). Mult(., Educ, Occ). 28.27801364 9
Mult(1, ., Occ).Educ1 Mult(1, ., Occ).Educ1 0.31457624 10
Mult(1, ., Occ).Educ2 Mult(1, ., Occ).Educ2 0.06872003 11
Mult(1, ., Occ).Educ3 Mult(1, ., Occ).Educ3 -0.01107907 12
Mult(1, ., Occ).Educ4 Mult(1, ., Occ).Educ4 -0.21810595 13
Mult(1, Educ, .).Occ1 Mult(1, Educ, .).Occ1 0.15385314 14
Mult(1, Educ, .).Occ2 Mult(1, Educ, .).Occ2 -0.04772764 15
Mult(1, Educ, .).Occ3 Mult(1, Educ, .).Occ3 -0.15638745 16
Mult(1, Educ, .).Occ4 Mult(1, Educ, .).Occ4 -0.23730565 17
Mult(1, Educ, .).Occ5 Mult(1, Educ, .).Occ5 -0.11388309 18
<- freq_tab_2.3B |>
RC gnm(
~ Educ + Occ + Mult(1, Educ, Occ),
Freq start = c(coef(O), 10, mult1),
family = poisson,
data = _,
tolerance = 1e-12
)
Running main iterations.........................................................
................................................................................
................................................................................
................................................................................
................................................................................
................................................................................
...........................................
Done
Warning in gnmFit(modelTools = modelTools, y = y, constrain = constrain, : Fitting algorithm has either not converged or converged
to a non-solution of the likelihood equations.
Use exitInfo() for numerical details of last iteration.
<- freq_tab_2.3B |>
RC2 gnm(
~ Educ + Occ + instances(Mult(1, Educ, Occ), 2),
Freq # start = c(coef(O), NA, mult2[,1], NA, mult2[,2]),
family = poisson,
data = _,
tolerance = 1e-12
)
Initialising
Running start-up iterations..
Running main iterations.....................................
Done
RC2
Call:
gnm(formula = Freq ~ Educ + Occ + instances(Mult(1, Educ, Occ),
2), family = poisson, data = freq_tab_2.3B, tolerance = 1e-12)
Coefficients:
(Intercept) Educ2
4.90354 -0.75950
Educ3 Educ4
1.50187 0.18447
Occ2 Occ3
0.01502 -2.22224
Occ4 Occ5
0.10667 -3.38853
Mult(., Educ, Occ, inst = 1). Mult(1, ., Occ, inst = 1).Educ1
1.54189 1.35778
Mult(1, ., Occ, inst = 1).Educ2 Mult(1, ., Occ, inst = 1).Educ3
0.27886 -0.20567
Mult(1, ., Occ, inst = 1).Educ4 Mult(1, Educ, ., inst = 1).Occ1
-0.89120 0.67274
Mult(1, Educ, ., inst = 1).Occ2 Mult(1, Educ, ., inst = 1).Occ3
-0.31932 -0.42628
Mult(1, Educ, ., inst = 1).Occ4 Mult(1, Educ, ., inst = 1).Occ5
-0.59644 0.51900
Mult(., Educ, Occ, inst = 2). Mult(1, ., Occ, inst = 2).Educ1
0.26953 -5.13301
Mult(1, ., Occ, inst = 2).Educ2 Mult(1, ., Occ, inst = 2).Educ3
-2.79039 -6.48668
Mult(1, ., Occ, inst = 2).Educ4 Mult(1, Educ, ., inst = 2).Occ1
8.06413 0.04503
Mult(1, Educ, ., inst = 2).Occ2 Mult(1, Educ, ., inst = 2).Occ3
-0.22275 0.06955
Mult(1, Educ, ., inst = 2).Occ4 Mult(1, Educ, ., inst = 2).Occ5
0.14602 0.69295
Deviance: 0.6001022
Pearson chi-squared: 0.5746549
Residual df: 2
<- freq_tab_2.3B |>
RC3 gnm(
~ Educ + Occ + instances(Mult(1, Educ, Occ), 3),
Freq start = c(coef(O), NA, mult3[, 1], NA, mult3[, 2], NA, mult3[, 3]),
family = poisson,
data = _,
tolerance = 1e-12
)
Initialising
Running start-up iterations..
Running main iterations......
Done
RC3
Call:
gnm(formula = Freq ~ Educ + Occ + instances(Mult(1, Educ, Occ),
3), family = poisson, data = freq_tab_2.3B, start = c(coef(O),
NA, mult3[, 1], NA, mult3[, 2], NA, mult3[, 3]), tolerance = 1e-12)
Coefficients:
(Intercept) Educ2
4.95717 -0.82096
Educ3 Educ4
1.80233 0.56088
Occ2 Occ3
-0.01071 -2.60229
Occ4 Occ5
-0.03443 -3.33220
Mult(., Educ, Occ, inst = 1). Mult(1, ., Occ, inst = 1).Educ1
0.07701 4.49001
Mult(1, ., Occ, inst = 1).Educ2 Mult(1, ., Occ, inst = 1).Educ3
0.73209 -0.80675
Mult(1, ., Occ, inst = 1).Educ4 Mult(1, Educ, ., inst = 1).Occ1
-3.27385 4.25316
Mult(1, Educ, ., inst = 1).Occ2 Mult(1, Educ, ., inst = 1).Occ3
-0.45231 -1.88306
Mult(1, Educ, ., inst = 1).Occ4 Mult(1, Educ, ., inst = 1).Occ5
-3.54657 0.57475
Mult(., Educ, Occ, inst = 2). Mult(1, ., Occ, inst = 2).Educ1
0.03847 0.71197
Mult(1, ., Occ, inst = 2).Educ2 Mult(1, ., Occ, inst = 2).Educ3
-0.60272 -2.69755
Mult(1, ., Occ, inst = 2).Educ4 Mult(1, Educ, ., inst = 2).Occ1
2.85641 0.42735
Mult(1, Educ, ., inst = 2).Occ2 Mult(1, Educ, ., inst = 2).Occ3
-3.63366 1.48249
Mult(1, Educ, ., inst = 2).Occ4 Mult(1, Educ, ., inst = 2).Occ5
1.63057 9.18646
Mult(., Educ, Occ, inst = 3). Mult(1, ., Occ, inst = 3).Educ1
0.18372 -0.83753
Mult(1, ., Occ, inst = 3).Educ2 Mult(1, ., Occ, inst = 3).Educ3
0.12534 -1.49027
Mult(1, ., Occ, inst = 3).Educ4 Mult(1, Educ, ., inst = 3).Occ1
-1.01651 1.23176
Mult(1, Educ, ., inst = 3).Occ2 Mult(1, Educ, ., inst = 3).Occ3
0.88823 -0.30798
Mult(1, Educ, ., inst = 3).Occ4 Mult(1, Educ, ., inst = 3).Occ5
1.20713 3.02765
Deviance: 1.625367e-13
Pearson chi-squared: 3.227351e-27
Residual df: 0
bind_rows(model.summary(O),
model.summary(RC),
model.summary(RC2),
model.summary(RC3))
# A tibble: 4 × 6
`Model Description` df L2 BIC Delta p
<chr> <int> <dbl> <dbl> <dbl> <dbl>
1 O 12 1.37e+ 3 1.27e+ 3 2.39e+ 1 1
2 RC 6 1.66e+ 4 1.66e+ 4 3.12e+ 0 1
3 RC2 2 6.00e- 1 -1.59e+ 1 9.35e- 2 0.259
4 RC3 0 1.63e-13 1.63e-13 3.67e-14 1
<- anoas(tab_2.3B, nd = 3) anoas_model
Fitting independence model...
Fitting model with 1 dimension...
Initialising
Running start-up iterations..
Running main iterations.........................................................
...
Done
Fitting model with 2 dimensions...
Initialising
Running start-up iterations..
Running main iterations........
Done
Fitting model with 3 dimensions...
Initialising
Running start-up iterations..
Running main iterations......
Done
anoas_model
Res. Df Res. Dev Dev./Indep. (%) Dissim. (%)
Indep. 12 1373.1757656522454 100.000000000000000 23.8615752953
RC(1) 6 125.0597485501469 9.107337289101130 6.4360390978
RC(2) 2 0.6001022352683 0.043701778772891 0.0935165802
RC(3) 0 -0.0000000000001 -0.000000000000008 0.0000000005
BIC AIC Dev. Df
Indep. 1274.0809153306573 1349.1757656522454 NA NA
RC(1) 75.5123233893528 113.0597485501469 -1248.1 -6
RC(2) -15.9157061516631 -3.3998977647317 -124.5 -4
RC(3) -0.0000000000001 -0.0000000000001 -0.6 -2
位相モデル
occupationalStatus
destination
origin 1 2 3 4 5 6 7 8
1 50 19 26 8 7 11 6 2
2 16 40 34 18 11 20 8 3
3 12 35 65 66 35 88 23 21
4 11 20 58 110 40 183 64 32
5 2 8 12 23 25 46 28 12
6 12 28 102 162 90 554 230 177
7 0 6 19 40 21 158 143 71
8 0 3 14 32 15 126 91 106
<- data.frame(occupationalStatus)
freq_occupationalStatus <- freq_occupationalStatus |>
freq_occupationalStatus mutate(
diag = ifelse(origin == destination, origin, 0) |> factor(),
Rscore = scale(as.numeric(origin), scale = FALSE),
Cscore = scale(as.numeric(destination), scale = FALSE)
)
<-
fit_O gnm(Freq ~ origin + destination, family = poisson, data = freq_occupationalStatus)
<-
fit_QI gnm(Freq ~ origin + destination + diag,
family = poisson,
data = freq_occupationalStatus)
<-
fit_U gnm(Freq ~ origin + destination + Rscore:Cscore,
family = poisson,
data = freq_occupationalStatus)
<-
fit_QI_U gnm(Freq ~ origin + destination + diag + Rscore:Cscore,
family = poisson,
data = freq_occupationalStatus)
<-
fit_S gnm(Freq ~ origin + destination + origin:destination,
family = poisson,
data = freq_occupationalStatus)
<- freq_occupationalStatus |>
freq_occupationalStatus mutate(
diag1 = ifelse(origin == 1 &
== destination, 1, 0) |> factor(),
origin diag2 = ifelse(origin == 2 &
== destination, 1, 0) |> factor(),
origin diag3 = ifelse(origin == 3 &
== destination, 1, 0) |> factor(),
origin diag4 = ifelse(origin == 4 &
== destination, 1, 0) |> factor(),
origin diag5 = ifelse(origin == 5 &
== destination, 1, 0) |> factor(),
origin diag6 = ifelse(origin == 6 &
== destination, 1, 0) |> factor(),
origin diag7 = ifelse(origin == 7 &
== destination, 1, 0) |> factor(),
origin diag8 = ifelse(origin == 8 &
== destination, 1, 0) |> factor()
origin
)
<-
fit_QI2 gnm(
~ origin + destination + diag1 + diag2 + diag3 + diag4 + diag5 + diag6 + diag7 + diag8,
Freq family = poisson,
data = freq_occupationalStatus
)
summary(fit_QI)
Call:
gnm(formula = Freq ~ origin + destination + diag, family = poisson,
data = freq_occupationalStatus)
Deviance Residuals:
Min 1Q Median 3Q Max
-4.567e+00 -2.318e+00 -1.045e-07 1.018e+00 6.152e+00
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.36346 0.17892 2.031 0.042211 *
origin2 0.35445 0.14755 2.402 0.016292 *
origin3 1.34923 0.12758 10.575 < 2e-16 ***
origin4 1.76957 0.12322 14.362 < 2e-16 ***
origin5 0.56615 0.14257 3.971 7.16e-05 ***
origin6 2.72612 0.11933 22.845 < 2e-16 ***
origin7 1.54999 0.12619 12.283 < 2e-16 ***
origin8 1.37488 0.12757 10.777 < 2e-16 ***
destination2 0.82044 0.16521 4.966 6.83e-07 ***
destination3 1.69007 0.15065 11.219 < 2e-16 ***
destination4 2.02648 0.14771 13.719 < 2e-16 ***
destination5 1.43966 0.15317 9.399 < 2e-16 ***
destination6 2.96856 0.14439 20.559 < 2e-16 ***
destination7 2.24512 0.14547 15.434 < 2e-16 ***
destination8 1.87534 0.14855 12.624 < 2e-16 ***
diag1 3.54857 0.22806 15.560 < 2e-16 ***
diag2 2.15053 0.20737 10.370 < 2e-16 ***
diag3 0.77163 0.15275 5.052 4.38e-07 ***
diag4 0.54098 0.12287 4.403 1.07e-05 ***
diag5 0.84961 0.22965 3.700 0.000216 ***
diag6 0.25903 0.07531 3.439 0.000583 ***
diag7 0.80428 0.11438 7.031 2.04e-12 ***
diag8 1.04976 0.12946 8.109 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Residual deviance: 446.84 on 41 degrees of freedom
AIC: 815.18
Number of iterations: 5
summary(fit_QI2)
Call:
gnm(formula = Freq ~ origin + destination + diag1 + diag2 + diag3 +
diag4 + diag5 + diag6 + diag7 + diag8, family = poisson,
data = freq_occupationalStatus)
Deviance Residuals:
Min 1Q Median 3Q Max
-4.567e+00 -2.318e+00 -1.045e-07 1.018e+00 6.152e+00
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.36346 0.17892 2.031 0.042211 *
origin2 0.35445 0.14755 2.402 0.016292 *
origin3 1.34923 0.12758 10.575 < 2e-16 ***
origin4 1.76957 0.12322 14.362 < 2e-16 ***
origin5 0.56615 0.14257 3.971 7.16e-05 ***
origin6 2.72612 0.11933 22.845 < 2e-16 ***
origin7 1.54999 0.12619 12.283 < 2e-16 ***
origin8 1.37488 0.12757 10.777 < 2e-16 ***
destination2 0.82044 0.16521 4.966 6.83e-07 ***
destination3 1.69007 0.15065 11.219 < 2e-16 ***
destination4 2.02648 0.14771 13.719 < 2e-16 ***
destination5 1.43966 0.15317 9.399 < 2e-16 ***
destination6 2.96856 0.14439 20.559 < 2e-16 ***
destination7 2.24512 0.14547 15.434 < 2e-16 ***
destination8 1.87534 0.14855 12.624 < 2e-16 ***
diag11 3.54857 0.22806 15.560 < 2e-16 ***
diag21 2.15053 0.20737 10.370 < 2e-16 ***
diag31 0.77163 0.15275 5.052 4.38e-07 ***
diag41 0.54098 0.12287 4.403 1.07e-05 ***
diag51 0.84961 0.22965 3.700 0.000216 ***
diag61 0.25903 0.07531 3.439 0.000583 ***
diag71 0.80428 0.11438 7.031 2.04e-12 ***
diag81 1.04976 0.12946 8.109 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Residual deviance: 446.84 on 41 degrees of freedom
AIC: 815.18
Number of iterations: 5
anova(fit_O, fit_QI, fit_U, fit_QI_U, fit_S)
Analysis of Deviance Table
Model 1: Freq ~ origin + destination
Model 2: Freq ~ origin + destination + diag
Model 3: Freq ~ origin + destination + Rscore:Cscore
Model 4: Freq ~ origin + destination + diag + Rscore:Cscore
Model 5: Freq ~ origin + destination + origin:destination
Resid. Df Resid. Dev Df Deviance
1 49 954.49
2 41 446.84 8 507.65
3 48 164.33 -7 282.51
4 40 58.44 8 105.89
5 0 0.00 40 58.44
bind_rows(
model.summary(fit_O),
model.summary(fit_QI),
model.summary(fit_U),
model.summary(fit_QI_U),
model.summary(fit_S)
)
# A tibble: 5 × 6
`Model Description` df L2 BIC Delta p
<chr> <int> <dbl> <dbl> <dbl> <dbl>
1 fit_O 49 9.54e+2 5.55e+2 1.66e+ 1 1
2 fit_QI 41 4.47e+2 1.12e+2 1.00e+ 1 1
3 fit_U 48 1.64e+2 -2.27e+2 7.26e+ 0 1.00
4 fit_QI_U 40 5.84e+1 -2.68e+2 3.53e+ 0 0.970
5 fit_S 0 4.50e-8 4.50e-8 3.22e-10 1
data(erikson)
erikson
, , country = EW
destination
origin I II III IVa IVb IVc V/VI VIIa VIIb
I 311 130 79 24 22 7 70 44 1
II 161 128 66 22 11 6 112 47 1
III 128 109 89 26 25 3 197 113 4
IVa 88 83 43 72 41 5 112 64 4
IVb 36 45 38 27 47 3 110 80 4
IVc 43 23 25 16 14 99 86 81 40
V/VI 356 375 325 108 140 5 1506 839 22
VIIa 150 180 187 48 74 9 802 685 15
VIIb 12 14 18 5 18 10 96 114 56
, , country = F
destination
origin I II III IVa IVb IVc V/VI VIIa VIIb
I 105 72 19 9 8 3 26 11 1
II 59 113 37 9 14 0 54 34 2
III 40 86 64 10 20 4 103 61 4
IVa 38 37 17 38 23 2 36 22 1
IVb 40 68 55 38 95 10 92 74 7
IVc 27 74 77 27 52 461 156 286 73
V/VI 36 138 93 22 38 5 339 189 9
VIIa 22 88 79 18 24 8 235 209 11
VIIb 4 18 26 9 14 19 68 107 47
, , country = S
destination
origin I II III IVa IVb IVc V/VI VIIa VIIb
I 52 15 13 3 2 0 11 7 0
II 30 27 14 3 4 0 27 12 2
III 10 19 10 2 4 0 16 11 1
IVa 26 24 5 20 8 1 33 22 0
IVb 8 13 6 3 9 4 31 20 1
IVc 24 47 44 17 22 92 132 144 21
V/VI 33 89 40 13 18 5 188 104 5
VIIa 32 49 28 14 17 5 159 109 4
VIIb 5 10 3 0 6 3 33 42 8
dimnames(erikson)
$origin
[1] "I" "II" "III" "IVa" "IVb" "IVc" "V/VI" "VIIa" "VIIb"
$destination
[1] "I" "II" "III" "IVa" "IVb" "IVc" "V/VI" "VIIa" "VIIb"
$country
[1] "EW" "F" "S"
dimnames(erikson)$origin <-
c("I+II","I+II","III","IVab","IVab","IVc","V/VI","VIIa","VIIb")
dimnames(erikson)$destination <-
c("I+II","I+II","III","IVab","IVab","IVc","V/VI","VIIa","VIIb")
<- data.frame(erikson)
freq_erikson <-
erikson2 xtabs(Freq ~ origin + destination + country, data = freq_erikson)
<- data.frame(erikson2)
freq_erikson
<- rep(c(2, 3, 4, 6, 5, 6, 6,
levelMatrix 3, 3, 4, 6, 4, 5, 6,
4, 4, 2, 5, 5, 5, 5,
6, 6, 5, 1, 6, 5, 2,
4, 4, 5, 6, 3, 4, 5,
5, 4, 5, 5, 3, 3, 5,
6, 6, 5, 3, 5, 4, 1), times = 3) |> as.factor()
<- bind_cols(freq_erikson, levelMatrix = levelMatrix)
d
<-
fit_O gnm(
~ origin + destination + country + origin * country +
Freq * country,
destination family = poisson,
data = d
)
<- gnm(
fit_Common ~ origin + destination + country +
Freq * country + destination * country +
origin * destination,
origin family = poisson,
data = d
)
<- gnm(
fit_Common_Pattern ~ origin + destination + country +
Freq * country + destination * country + levelMatrix,
origin family = poisson,
data = d
)
<- d |>
d mutate(
pred1 = fit_O$fitted.values,
pred2 = fit_Common$fitted.values,
pred3 = fit_Common_Pattern$fitted.values
)
summary(fit_O)
Call:
gnm(formula = Freq ~ origin + destination + country + origin *
country + destination * country, family = poisson, data = d)
Deviance Residuals:
Min 1Q Median 3Q Max
-12.763 -3.562 -1.393 1.767 22.208
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 5.74389 0.03348 171.575 < 2e-16 ***
originIII -0.58201 0.04739 -12.281 < 2e-16 ***
originIVab -0.31986 0.04375 -7.312 2.64e-13 ***
originIVc -1.06769 0.05610 -19.032 < 2e-16 ***
originV/VI 1.08510 0.03282 33.062 < 2e-16 ***
originVIIa 0.54874 0.03564 15.397 < 2e-16 ***
originVIIb -1.28675 0.06100 -21.095 < 2e-16 ***
destinationIII -1.00300 0.03964 -25.305 < 2e-16 ***
destinationIVab -1.16484 0.04211 -27.664 < 2e-16 ***
destinationIVc -2.78106 0.08498 -32.724 < 2e-16 ***
destinationV/VI 0.26476 0.02730 9.699 < 2e-16 ***
destinationVIIa -0.13764 0.03009 -4.574 4.78e-06 ***
destinationVIIb -2.78106 0.08500 -32.720 < 2e-16 ***
countryF -0.88695 0.05988 -14.811 < 2e-16 ***
countryS -1.74777 0.08424 -20.747 < 2e-16 ***
originIII:countryF 0.19716 0.08083 2.439 0.014718 *
originIVab:countryF 0.50479 0.07136 7.073 1.51e-12 ***
originIVc:countryF 1.82879 0.07546 24.235 < 2e-16 ***
originV/VI:countryF -0.67387 0.06296 -10.703 < 2e-16 ***
originVIIa:countryF -0.36238 0.06669 -5.434 5.51e-08 ***
originVIIb:countryF 0.67364 0.09307 7.238 4.55e-13 ***
originIII:countryS -0.53021 0.14300 -3.708 0.000209 ***
originIVab:countryS 0.37251 0.10340 3.603 0.000315 ***
originIVc:countryS 1.96213 0.09743 20.138 < 2e-16 ***
originV/VI:countryS -0.28322 0.08719 -3.248 0.001161 **
originVIIa:countryS 0.08166 0.09040 0.903 0.366354
originVIIb:countryS 0.58455 0.13159 4.442 8.90e-06 ***
destinationIII:countryF 0.17859 0.06820 2.619 0.008827 **
destinationIVab:countryF 0.34258 0.06963 4.920 8.66e-07 ***
destinationIVc:countryF 2.04865 0.10057 20.370 < 2e-16 ***
destinationV/VI:countryF -0.22428 0.05085 -4.411 1.03e-05 ***
destinationVIIa:countryF 0.06764 0.05340 1.267 0.205290
destinationVIIb:countryF 0.85375 0.12089 7.062 1.64e-12 ***
destinationIII:countryS -0.14353 0.09826 -1.461 0.144099
destinationIVab:countryS 0.03051 0.09891 0.308 0.757741
destinationIVc:countryS 1.24126 0.13514 9.185 < 2e-16 ***
destinationV/VI:countryS -0.05932 0.06543 -0.907 0.364667
destinationVIIa:countryS 0.05222 0.07055 0.740 0.459234
destinationVIIb:countryS 0.27845 0.18161 1.533 0.125225
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Residual deviance: 4860 on 108 degrees of freedom
AIC: 5752.1
Number of iterations: 6
names(fit_Common)
[1] "call" "formula" "terms" "data"
[5] "eliminate" "ofInterest" "na.action" "xlevels"
[9] "offset" "tolerance" "iterStart" "iterMax"
[13] "coefficients" "residuals" "fitted.values" "rank"
[17] "family" "predictors" "deviance" "aic"
[21] "iter" "weights" "prior.weights" "df.residual"
[25] "y" "converged" "constrain" "constrainTo"
[29] "x" "model"
names(summary(fit_Common))
[1] "call" "ofInterest" "family" "deviance"
[5] "aic" "df.residual" "iter" "deviance.resid"
[9] "coefficients" "eliminated" "dispersion" "df"
[13] "cov.scaled"
summary(fit_Common)
Call:
gnm(formula = Freq ~ origin + destination + country + origin *
country + destination * country + origin * destination, family = poisson,
data = d)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.894368 -0.493141 -0.001321 0.470201 2.903940
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 6.59629 0.03453 191.003 < 2e-16 ***
originIII -1.13823 0.06560 -17.351 < 2e-16 ***
originIVab -1.07370 0.06143 -17.479 < 2e-16 ***
originIVc -2.70361 0.09016 -29.987 < 2e-16 ***
originV/VI 0.01007 0.04703 0.214 0.830527
originVIIa -0.77338 0.05726 -13.507 < 2e-16 ***
originVIIb -3.26650 0.13781 -23.702 < 2e-16 ***
destinationIII -1.69227 0.07692 -22.001 < 2e-16 ***
destinationIVab -2.25353 0.09612 -23.445 < 2e-16 ***
destinationIVc -4.55452 0.25826 -17.635 < 2e-16 ***
destinationV/VI -1.34800 0.06703 -20.112 < 2e-16 ***
destinationVIIa -2.03630 0.08773 -23.212 < 2e-16 ***
destinationVIIb -5.12499 0.38197 -13.417 < 2e-16 ***
countryF -0.79371 0.05423 -14.637 < 2e-16 ***
countryS -1.65837 0.07661 -21.646 < 2e-16 ***
originIII:countryF 0.20390 0.08179 2.493 0.012668 *
originIVab:countryF 0.48071 0.07350 6.540 6.15e-11 ***
originIVc:countryF 1.61954 0.08393 19.295 < 2e-16 ***
originV/VI:countryF -0.64330 0.06586 -9.767 < 2e-16 ***
originVIIa:countryF -0.33935 0.07019 -4.835 1.33e-06 ***
originVIIb:countryF 0.64616 0.09861 6.553 5.65e-11 ***
originIII:countryS -0.49402 0.14390 -3.433 0.000597 ***
originIVab:countryS 0.42215 0.10589 3.987 6.70e-05 ***
originIVc:countryS 2.10894 0.10644 19.814 < 2e-16 ***
originV/VI:countryS -0.23466 0.09102 -2.578 0.009934 **
originVIIa:countryS 0.14235 0.09505 1.498 0.134221
originVIIb:countryS 0.72346 0.13754 5.260 1.44e-07 ***
destinationIII:countryF 0.17483 0.07130 2.452 0.014209 *
destinationIVab:countryF 0.18250 0.07402 2.465 0.013684 *
destinationIVc:countryF 0.73972 0.11572 6.392 1.64e-10 ***
destinationV/VI:countryF -0.11294 0.05496 -2.055 0.039884 *
destinationVIIa:countryF 0.02129 0.05885 0.362 0.717449
destinationVIIb:countryF 0.11636 0.13452 0.865 0.387023
destinationIII:countryS -0.22236 0.10142 -2.192 0.028352 *
destinationIVab:countryS -0.17172 0.10342 -1.660 0.096839 .
destinationIVc:countryS -0.38697 0.15155 -2.553 0.010668 *
destinationV/VI:countryS -0.09561 0.07021 -1.362 0.173263
destinationVIIa:countryS -0.17583 0.07672 -2.292 0.021913 *
destinationVIIb:countryS -0.64986 0.19498 -3.333 0.000859 ***
originIII:destinationIII 0.76642 0.11807 6.491 8.52e-11 ***
originIVab:destinationIII 0.52595 0.11560 4.550 5.37e-06 ***
originIVc:destinationIII 1.17849 0.13041 9.037 < 2e-16 ***
originV/VI:destinationIII 0.87374 0.09195 9.502 < 2e-16 ***
originVIIa:destinationIII 1.10866 0.10285 10.779 < 2e-16 ***
originVIIb:destinationIII 1.36163 0.20619 6.604 4.01e-11 ***
originIII:destinationIVab 0.69419 0.15016 4.623 3.78e-06 ***
originIVab:destinationIVab 2.02108 0.11352 17.804 < 2e-16 ***
originIVc:destinationIVab 1.73618 0.14216 12.213 < 2e-16 ***
originV/VI:destinationIVab 1.12813 0.11169 10.101 < 2e-16 ***
originVIIa:destinationIVab 1.25162 0.12471 10.036 < 2e-16 ***
originVIIb:destinationIVab 2.01369 0.20909 9.631 < 2e-16 ***
originIII:destinationIVc 0.23560 0.45713 0.515 0.606273
originIVab:destinationIVc 1.24669 0.32500 3.836 0.000125 ***
originIVc:destinationIVc 5.21749 0.26575 19.633 < 2e-16 ***
originV/VI:destinationIVc 0.18607 0.36231 0.514 0.607553
originVIIa:destinationIVc 1.22166 0.33304 3.668 0.000244 ***
originVIIb:destinationIVc 3.56730 0.33324 10.705 < 2e-16 ***
originIII:destinationV/VI 1.17516 0.09949 11.812 < 2e-16 ***
originIVab:destinationV/VI 1.20044 0.09270 12.950 < 2e-16 ***
originIVc:destinationV/VI 1.88309 0.10710 17.582 < 2e-16 ***
originV/VI:destinationV/VI 2.05945 0.07524 27.372 < 2e-16 ***
originVIIa:destinationV/VI 2.21492 0.08327 26.601 < 2e-16 ***
originVIIb:destinationV/VI 2.54647 0.15871 16.045 < 2e-16 ***
originIII:destinationVIIa 1.28947 0.12352 10.440 < 2e-16 ***
originIVab:destinationVIIa 1.46717 0.11334 12.944 < 2e-16 ***
originIVc:destinationVIIa 2.84331 0.11806 24.084 < 2e-16 ***
originV/VI:destinationVIIa 2.14755 0.09583 22.410 < 2e-16 ***
originVIIa:destinationVIIa 2.70994 0.10109 26.807 < 2e-16 ***
originVIIb:destinationVIIa 3.48535 0.16446 21.193 < 2e-16 ***
originIII:destinationVIIb 1.34327 0.50723 2.648 0.008091 **
originIVab:destinationVIIb 1.75599 0.45232 3.882 0.000104 ***
originIVc:destinationVIIb 4.65198 0.39743 11.705 < 2e-16 ***
originV/VI:destinationVIIb 1.80532 0.41541 4.346 1.39e-05 ***
originVIIa:destinationVIIb 2.31365 0.42297 5.470 4.50e-08 ***
originVIIb:destinationVIIb 5.72803 0.41103 13.936 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Residual deviance: 121.3 on 72 degrees of freedom
AIC: 1085.4
Number of iterations: 4
anova(fit_O, fit_Common_Pattern, fit_Common)
Analysis of Deviance Table
Model 1: Freq ~ origin + destination + country + origin:country + destination:country
Model 2: Freq ~ origin + destination + country + origin:country + destination:country +
levelMatrix
Model 3: Freq ~ origin + destination + country + origin:country + destination:country +
origin:destination
Resid. Df Resid. Dev Df Deviance
1 108 4860.0
2 103 505.6 5 4354.4
3 72 121.3 31 384.3
連関モデルと正準相関分析
Goodman (1981) のTable 1のaより.
library(tidyverse)
library(gnm)
<- c(5, 3, 10, 11, 4, 5, 8, 6, 26, 11, 3, 6, 23, 11, 1, 2)
Freq <- gl(n = 4, k = 4)
Row <- gl(n = 4, k = 1, length = 16)
Col <- tibble(Freq, Row, Col) |>
d mutate(U = as.numeric(Row),
V = as.numeric(Col))
xtabs(Freq ~ Row + Col, data = d)
Col
Row 1 2 3 4
1 5 3 10 11
2 4 5 8 6
3 26 11 3 6
4 23 11 1 2
# (1) O
<- d |>
O gnm(Freq ~ Row + Col,
family = poisson,
data = _)
# (2) U
<- d |>
U gnm(Freq ~ Row + Col + U:V,
family = poisson,
data = _)
# (3) R
<- d |>
R gnm(Freq ~ Row + Col + Row:V,
family = poisson,
data = _)
# (4) C
<- d |>
C gnm(Freq ~ Row + Col + Col:U,
family = poisson,
data = _)
# (5) RC
<- d |>
RC gnm(Freq ~ Row + Col + Mult(1, Row, Col),
family = poisson,
data = _)
Initialising
Running start-up iterations..
Running main iterations........
Done
# (6) U + RC
<- d |>
UplusRC gnm(Freq ~ Row + Col + U:V + Mult(1, Row, Col),
family = poisson,
data = _)
Initialising
Running start-up iterations..
Running main iterations..............
Done
# (7) R + RC
<- d |>
RplusRC gnm(Freq ~ Row + Col + Row:V + Mult(1, Row, Col),
family = poisson,
data = _)
Initialising
Running start-up iterations..
Running main iterations...............
Done
# (8) C + RC
<- d |>
CplusRC gnm(Freq ~ Row + Col + Col:U + Mult(1, Row, Col),
family = poisson,
data = _)
Initialising
Running start-up iterations..
Running main iterations....
Done
# (9) R + C + RC
<- d |>
RplusCplusRC gnm(Freq ~ Row + Col + Row:V + Col:U + Mult(1, Row, Col),
family = poisson,
data = _)
Initialising
Running start-up iterations..
Running main iterations..
Done
# (10) R + C
<- d |>
RplusC gnm(Freq ~ Row + Col + Row:V + Col:U,
family = poisson,
data = _)
list(O, U, R, C, RC, UplusRC, RplusRC, CplusRC, RplusCplusRC, RplusC) |>
map_dfr(glance, id = "Model")
# A tibble: 10 × 8
null.deviance df.null logLik AIC BIC deviance df.residual nobs
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <int>
1 NA NA -53.0 120. 125. 46.9 9 16
2 NA NA -35.5 86.9 93.1 11.9 8 16
3 NA NA -34.5 88.9 96.7 9.88 6 16
4 NA NA -31.7 83.4 91.1 4.35 6 16
5 NA NA -30.4 84.8 94.1 1.74 4 16
6 NA NA -30.3 86.7 96.7 1.60 3 16
7 NA NA -30.3 88.6 99.4 1.49 2 16
8 NA NA -29.5 87.1 97.9 0.00771 2 16
9 NA NA -29.5 89.1 101. 0.00000129 1 16
10 NA NA -30.9 85.9 95.2 2.81 4 16
<-
fit gnm(Freq ~ Row + Col + Mult(1, Row, Col),
family = poisson,
data = d)
Initialising
Running start-up iterations..
Running main iterations........
Done
summary(fit)
Call:
gnm(formula = Freq ~ Row + Col + Mult(1, Row, Col), family = poisson,
data = d)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.51267 -0.25916 -0.03574 0.25369 0.66120
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.2607 NA NA NA
Row2 -0.1177 NA NA NA
Row3 0.6089 NA NA NA
Row4 0.1565 NA NA NA
Col2 -0.5289 NA NA NA
Col3 -1.1438 NA NA NA
Col4 -0.7842 NA NA NA
Mult(., Row, Col). -10.0887 NA NA NA
Mult(1, ., Col).Row1 0.4145 NA NA NA
Mult(1, ., Col).Row2 0.3209 NA NA NA
Mult(1, ., Col).Row3 -0.1926 NA NA NA
Mult(1, ., Col).Row4 -0.4234 NA NA NA
Mult(1, Row, .).Col1 0.1759 NA NA NA
Mult(1, Row, .).Col2 0.0975 NA NA NA
Mult(1, Row, .).Col3 -0.2997 NA NA NA
Mult(1, Row, .).Col4 -0.1962 NA NA NA
Std. Error is NA where coefficient has been constrained or is unidentified
Residual deviance: 1.7442 on 4 degrees of freedom
AIC: 84.814
Number of iterations: 8
<- with(d, tapply(Freq, Row, sum) / sum(Freq))
rowProbs <- with(d, tapply(Freq, Col, sum) / sum(Freq))
colProbs <- getContrasts(
mu
fit,pickCoef(fit, "[.]Row"),
ref = rowProbs,
scaleRef = rowProbs,
scaleWeights = rowProbs
)<- getContrasts(
nu
fit,pickCoef(fit, "[.]Col"),
ref = colProbs,
scaleRef = colProbs,
scaleWeights = colProbs
)<-
fit gnm(
~ Row + Col + Mult(1, Row, Col),
Freq family = poisson,
data = d,
constrain = 9:16,
constrainTo = c(mu$qvframe[, 1], -1 * nu$qvframe[, 1])
)
Initialising
Running main iterations
Done
<- rep(mu$qvframe[, 1], each = 4)
mu_score <- rep(nu$qvframe[, 1], 4)
nu_score <- d |> mutate(mu = mu_score,
d nu = nu_score)
# Canonical correlation
library(wCorr)
wCorr v1.9.8
with(d, weightedCorr(mu, x = nu, weights = Freq, method = "Pearson"))
[1] -0.5585432
with(d, weightedCorr(U, x = V, weights = Freq, method = "Polychoric"))
[1] -0.5380634
library(polycor)
library(vcdExtra)
Attaching package: 'vcdExtra'
The following object is masked from 'package:dplyr':
summarise
<- expand.dft(d, dreq = "Freq")
d_ind d_ind
# A tibble: 135 × 6
Row Col U V mu nu
<int> <int> <int> <int> <dbl> <dbl>
1 1 1 1 1 1.34 0.851
2 1 1 1 1 1.34 0.851
3 1 1 1 1 1.34 0.851
4 1 1 1 1 1.34 0.851
5 1 1 1 1 1.34 0.851
6 1 2 1 2 1.34 0.444
7 1 2 1 2 1.34 0.444
8 1 2 1 2 1.34 0.444
9 1 3 1 3 1.34 -1.62
10 1 3 1 3 1.34 -1.62
# ℹ 125 more rows
library(DescTools)
CorPolychor(d_ind$U, d_ind$V, ML = TRUE)
[1] -0.5326198
#
summary(fit)
Call:
gnm(formula = Freq ~ Row + Col + Mult(1, Row, Col), constrain = 9:16,
constrainTo = c(mu$qvframe[, 1], -1 * nu$qvframe[, 1]), family = poisson,
data = d)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.51267 -0.25916 -0.03574 0.25369 0.66120
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.2730 0.2679 8.484 < 2e-16 ***
Row2 -0.1064 0.2823 -0.377 0.706328
Row3 0.6827 0.2698 2.530 0.011397 *
Row4 0.2584 0.2844 0.908 0.363656
Col2 -0.5588 0.2278 -2.454 0.014141 *
Col3 -1.3258 0.3082 -4.301 1.70e-05 ***
Col4 -0.9266 0.2677 -3.462 0.000536 ***
Mult(., Row, Col). 0.6577 0.1127 5.836 5.35e-09 ***
Mult(1, ., Col).Row1 1.3355 NA NA NA
Mult(1, ., Col).Row2 1.0593 NA NA NA
Mult(1, ., Col).Row3 -0.4565 NA NA NA
Mult(1, ., Col).Row4 -1.1376 NA NA NA
Mult(1, Row, .).Col1 -0.8514 NA NA NA
Mult(1, Row, .).Col2 -0.4441 NA NA NA
Mult(1, Row, .).Col3 1.6203 NA NA NA
Mult(1, Row, .).Col4 1.0823 NA NA NA
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for poisson family taken to be 1)
Std. Error is NA where coefficient has been constrained or is unidentified
Residual deviance: 1.7442 on 8 degrees of freedom
AIC: 76.814
Number of iterations: 0
<- fit$coefficients["Mult(., Row, Col)."] |> abs()
phi <- (-1 + sqrt(1 + 4 * phi ^ 2)) / (2 * phi)
rho <- (2 * phi) ^ (-1)
eta <- (1 + eta ^ 2) ^ (1 / 2) - eta
tau mu
Estimate Std. Error
Mult(1, ., Col).Row1 1.3354657 0.1909635
Mult(1, ., Col).Row2 1.0592605 0.2590555
Mult(1, ., Col).Row3 -0.4564888 0.2467937
Mult(1, ., Col).Row4 -1.1376490 0.2191522
nu
Estimate Std. Error
Mult(1, Row, .).Col1 0.8513968 0.1194283
Mult(1, Row, .).Col2 0.4440776 0.2763713
Mult(1, Row, .).Col3 -1.6203060 0.2558555
Mult(1, Row, .).Col4 -1.0822644 0.2870932
phi
Mult(., Row, Col).
0.6576831
rho
Mult(., Row, Col).
0.4959289
tau
Mult(., Row, Col).
0.4959289
<- abs((-1.3354658 - 1.1376491) / (1 - 4))
delta_mu <- abs((-0.8513968 - 1.0822644) / (1 - 4))
delta_nu # Adjusted
* ((1 - delta_mu / 12) * (1 - delta_nu / 12)) ^ (-1 / 2) tau
Mult(., Row, Col).
0.5282781
library(logmult)
<- matrix(Freq,
tab nrow = 4,
ncol = 4,
byrow = TRUE)
<- rc(tab,
rc2 nd = 1,
weighting = "marginal",
se = "bootstrap")
Initialising
Running start-up iterations..
Running main iterations...........
Done
Computing bootstrap standard errors...
.
Warning in jackboot(se, ncpus, nreplicates, tab, model, assoc1 =
getS3method("assoc", : 3 model replicates failed and their results will be
skipped. Standard errors will not be completely accurate. Consider raising the
value of iterMax.
summary(rc2)
Call:
rc(tab = tab, nd = 1, weighting = "marginal", se = "bootstrap")
Deviance Residuals:
Columns
Rows A B C D
A 0.18575 -0.40583 -0.21673 0.32921
B -0.38647 0.66120 0.30497 -0.51267
C 0.23692 -0.44850 -0.07819 0.21153
D -0.15877 0.30399 0.00672 -0.14657
Association coefficients:
Normalized Adjusted Std. error Pr(>|z|)
Dim1 0.65768 NA 0.2651 0.0130990 *
Dim1:RowsA 1.33547 1.08303 0.2442 4.533e-08 ***
Dim1:RowsB 1.05926 0.85904 0.3106 0.0006477 ***
Dim1:RowsC -0.45649 -0.37020 0.2656 0.0856311 .
Dim1:RowsD -1.13765 -0.92261 0.2738 3.243e-05 ***
Dim1:ColumnsA -0.85140 -0.69046 0.1382 7.336e-10 ***
Dim1:ColumnsB -0.44408 -0.36014 0.3170 0.1612772
Dim1:ColumnsC 1.62031 1.31403 0.3335 1.186e-06 ***
Dim1:ColumnsD 1.08226 0.87769 0.3662 0.0031246 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Normalization weights: marginal
Deviance: 1.744218
Pearson chi-squared: 1.760665
Dissimilarity index: 4.670712%
Residual df: 4
BIC: -17.87688
AIC: -6.255782
assoc(rc2)
$phi
Dim1
[1,] 0.6576832
$row
, , 1
Dim1
A 1.3354659
B 1.0592602
C -0.4564886
D -1.1376492
$col
, , 1
Dim1
A -0.8513968
B -0.4440776
C 1.6203060
D 1.0822643
$diagonal
numeric(0)
$weighting
[1] "marginal"
$row.weights
[,1]
A 29
B 23
C 46
D 37
$col.weights
[,1]
A 58
B 30
C 22
D 25
$vars
[1] "Rows" "Columns"
attr(,"class")
[1] "assoc.rc" "assoc"
Goodman, Leo A. 1981. “Association Models and Canonical Correlation in the Analysis of Cross-Classifications Having Ordered Categories.” Journal of the American Statistical Association 76 (374): 320–34. https://doi.org/10.1080/01621459.1981.10477651.