井出草平の研究ノート

ロジスティック回帰におけるモデル適合度の測定

こちらの論文で挙げられている方法を検討した。

www.ncbi.nlm.nih.gov

  • Weiss, B.A. and Dardick, W. (2016) ‘An Entropy-Based Measure for Assessing Fuzziness in Logistic Regression’, Educational and Psychological Measurement, 76(6), pp. 986–1004. Available at: https://doi.org/10.1177/0013164415623820.

二項ロジスティック回帰分析の推定

例題として使うので、適当に二項ロジスティック回帰分析の推定をしておく。

library(AER)
data(CPS1985)
head(CPS1985)
      wage education experience age ethnicity region gender occupation        sector union married
1     5.10         8         21  35  hispanic  other female     worker manufacturing    no     yes
1100  4.95         9         42  57      cauc  other female     worker manufacturing    no     yes
2     6.67        12          1  19      cauc  other   male     worker manufacturing    no      no
3     4.00        12          4  22      cauc  other   male     worker         other    no      no
4     7.50        12         17  35      cauc  other   male     worker         other    no     yes
5    13.07        13          9  28      cauc  other   male     worker         other   yes      no
# 二項ロジスティック回帰分析
fit <- glm(union ~ age + gender + wage + occupation,
                  data = CPS1985, family = binomial(link = "logit"))
summary(fit)
Coefficients:
                     Estimate Std. Error z value Pr(>|z|)    
(Intercept)          -2.68778    0.46643  -5.762 8.29e-09 ***
age                   0.02968    0.01028   2.886 0.003905 ** 
genderfemale         -0.61376    0.28655  -2.142 0.032204 *  
wage                  0.08753    0.02518   3.477 0.000508 ***
occupationtechnical  -0.55867    0.33890  -1.648 0.099258 .  
occupationservices   -0.09986    0.35508  -0.281 0.778535    
occupationoffice     -1.07916    0.44743  -2.412 0.015870 *  
occupationsales      -2.76139    1.04795  -2.635 0.008412 ** 
occupationmanagement -2.54377    0.67700  -3.757 0.000172 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 503.08  on 533  degrees of freedom
Residual deviance: 437.81  on 525  degrees of freedom
AIC: 455.81

Number of Fisher Scoring iterations: 6
  

逸脱度 deviance (-2LL)

ロジスティック回帰分析では、逸脱度 (-2LL) は、適合モデルを飽和モデルと比較することで、モデルの適合の欠如を表す数学量である (Cohen, Cohen, West, & Aiken, 2003)。そのため、観察された値が期待値とどれくらい違うかを表します。尤度比は、あるモデルの最大尤度と別のモデルの最大尤度の比であり、逸脱度は尤度比の対数に(-2)を乗じて計算される。デビアンス値がゼロの場合は完全な適合を表し、値が大きい場合は適合が悪いことを示す。逸脱度は、必ずしもカイ二乗分布に従うとは限らないので、それ自体で解釈するよりも、モデル比較に有用である (O'Connell & Amico, 2010; Peng, So, Stage, & St. John, 2002)。

尤度比χ2検定

尤度比カイ2乗検定 (LR χ2) は、より小さなモデル(多くの場合、ベースラインまたは切片のみのモデル)をより大きなモデルと比較するために逸脱度を用いる。対数尤度の変化は、2つのモデル間の-2LL値の差を取ることによって計算さ れる。-2LLの差はカイ2乗分布に従うので、その値はカイ2乗臨界値と比較できる。統計的に有意な結果は、より多くの予測変数を持つモデルが、より少ない予測変数を持つモデルよりも統計的に有意によくデータに適合することを示す。この検定の利点は、理論モデルがベースライン・モデルよりもよく適合するかどうかを決定するのに有用であり、入れ子モデルを比較する統計的検定として使用できることである。LR χ2 は、データが疎であるとき(しばしば連続的に測定される予測変数が使用されるときの結果)、または標本サイズが大きいときのデータ-モデル適合の限定された測定である。

Hosmer-Lemeshowカイ二乗検定

Hosmer-Lemeshowカイ二乗検定も適合度検定の一種で、データが疎な場合に有用である。この統計量は、予測された確率をパーセンタイル・ランクに基づく10個のグループ(十分位)に分割し、Pearson χ2を計算して、観察された度数と期待される度数を比較する。非統計的に有意な結果は、データとモデルの適合が良好であることを示す。この統計量は、保守的な検定(すなわち、低い第一種過誤率; Peng et al., 2002)とみなされ、連続予測変数が使用される場合に有用である。この尺度は、検出力の欠如を批判され、したがって、n > 400の場合のみ推奨される (Hosmer & Lemeshow, 2000)。対照的に、カイ2乗検定は、一般に標本サイズに非常に敏感で、したがって、大きなnでは、しばしば統計的に有意な結果(データ・モデルの適合が悪いことを示す)を出す。したがって、この検定の理想的な検出力のために必要な標本サイズのコンセンサスはありません。さらに、この尺度は、十進分類を作成するために使用されるカット・ポイントに敏感であり、したがって、数値HL χ2値は、ソフトウェア・プログラムによって異なる可能性がある(Hosmer, Hosmer, Le Cessie, & Lemeshow, 1997; Peng et al., 2002)。

Hosmer-Lemeshowカイ二乗検定の実行

すべてnumeric型にしないと走らないので、変数をいじる必要がある。

library(dplyr)

CPS1985$gender.num <- CPS1985$gender
CPS1985 <- CPS1985 %>%
  mutate(gender.num = case_when(
      gender.num == "male" ~ 1,
      gender.num == "female" ~ 2))

CPS1985$occupation.num <- CPS1985$occupation
CPS1985 <- CPS1985 %>%
  mutate(occupation.num = case_when(
      occupation.num == "worker" ~ 1,
      occupation.num == "technical" ~ 2,
      occupation.num == "services" ~ 3,
      occupation.num == "office" ~ 4,
      occupation.num == "sales" ~ 5,
      occupation.num == "management" ~ 6
      ))

CPS1985$union.num <- CPS1985$union
CPS1985 <- CPS1985 %>%
  mutate(union.num = case_when(
      union.num == "yes" ~ 1,
      union.num == "no" ~ 0))


### 従属変数のみのデータをpredprobに格納
predprob <- data.frame(age = CPS1985$age, gender = CPS1985$gender,
                       wage = CPS1985$wage, occupation = CPS1985$occupation)

### numeric型の変数を用いたモデルを作成
fit2 <- glm(union.num ~ age + gender.num + wage + occupation.num,
                  data = CPS1985, family = binomial(link = "logit"))

### Hosmer-Lemeshow検定を実行
hl_gof <- hoslem.test(CPS1985$union.num, fitted(fit2), g = 10)
hl_gof

5%水準以下の小さなP値は、モデルが不完全であることを示唆する。

 Hosmer and Lemeshow goodness of fit (GOF) test

data:  CPS1985$union.num, fitted(fit2)
X-squared = 3.5246, df = 8, p-value = 0.8973

擬似R二乗(分散説明)尺度

ロジスティック回帰では、モデルがデータにどれだけよく適合するかの効果量測定として、いくつかの擬似分散説明尺度が使用されることがある(たとえば、McFaddenのR2, Cox & Snell, 1989; Nagelkerke, 1991)。これらは、通常の最小2乗(OLS)回帰における多重R2と同様に解釈されることを意図しているが、カテゴリー的な結果の分散が連続的な結果の分散と異なるので、擬似R2指標とみなされる(Lomax & Hahs-Vaughn, 2012)。 これらの指標は、0から1の範囲(1はより良いデータ・モデル適合を示す)を意味するが、Cox and Snell (1989) の指標が1.0に等しくなることは数学的に不可能であり、どの擬似分散説明指標についても推奨されるカットオフ値は現在のところ存在しない。これらのうち、McFaddenのR2指数は、その解釈が重回帰のR2に最も似ているため、最も直感的に理解できますが、多くの市販統計ソフトでは利用できないため、手作業で計算しなければならず、一部の応用研究者にとっては望ましくない尺度となっています (O'Connell & Amico, 2010; Peng et al., 2002)。さらに、どの擬似R2値を報告するのが望ましいかについては、研究者の間でも意見が分かれている(O'Connell & Amico, 2010)。

RではDescToolsパッケージを用いて容易に計算ができる。

library(DescTools)
PseudoR2(fit, which = "all")
       McFadden     McFaddenAdj        CoxSnell      Nagelkerke   AldrichNelson VeallZimmermann           Efron McKelveyZavoina            Tjur 
     0.12973875      0.09395945      0.11505302      0.18855166      0.10891512      0.22452336      0.12640844      0.28229487      0.12434253 
            AIC             BIC          logLik         logLik0              G2 
   455.81462887    494.33819142   -218.90731444   -251.54206888     65.26950888 

正確性 accuracy / 正しく分類されたケースの割合

多くの研究者は、観察されたグループ・メンバーシップと予測されたグループ・メンバーシップのクロス集計を含む分類表に依存している。バイナリ・ロジスティック回帰では、予測確率が0.5以上のケースは、通常1つのグループに分類され、一方、予測確率が0.5未満のケースは、2番目のグループで予測されたグループ・メンバーシップになる(ただし、必要であれば、研究者は0.5以外のカット・ポイントを選択できる)。クロス集計表に基づいて、正しく分類されたケースのパーセンテージが計算され、データ・モデルの適合の尺度として使用できる。バイナリ・ロジスティック回帰のケースでは、分類率の値は、50% から100%の正しい分類の範囲であり、より大きな値は、よりよいデータ・モデルの適合を示す。

正しい分類のパーセンテージは、観察された頻度の小さいグループの誤分類率が大きいこと(特に、あるグループの標本サイズが小さいとき)、1つまたは複数のグループの潜在的な悪い分類率、したがって、分類率内のこれらのグループの過小表現、および基本率または偶然の分類が組み込まれていないこと(Lomax & Hahs-Vaughn, 2012; O'Connell & Amico, 2010)により、データ・モデルの適合の効果的な尺度でないと批判されることが多い。さらに、モデルはデータによく適合していると考えられるが、分類率が低いという状況も起こり得る。

正確性 accuracy の計算

回帰分析の推定結果を計算し、それを2値データに変換する。これが推定値である。
一方でもともとの従属変数がある。従属変数に比べて、推定モデルによって推定された結果は何%あっているのか、という計算をする。

caretパッケージのconfusionMatrix関数を使う。計算はnumeric型でしかできないため、先ほどの二項ロジスティック回帰分析の従属変数であった、unionをunion.numという変数にコピーして、これをnumeric型に変換しておく。

比較のための変数を作成する

## dplyrでCPS1985$unionのyesを1に、noを0に変換する
library(dplyr)
 CPS1985$union.num <- CPS1985$union
CPS1985 <- CPS1985 %>%
  mutate(union.num = case_when(
      union.num == "yes" ~ 1,
      union.num == "no" ~ 0))
library(caret)

### type = "response" 各観測に対して予測確率を与える
pred_probs <- predict(fit, CPS1985, type = "response") 

### 予測値を2値変数に変換する
pred_diagn <- ifelse(pred_probs > 0.5, 1, 0)

### 混同行列と精度
caret::confusionMatrix(data = as.factor(pred_diagn), 
                       reference = as.factor(CPS1985$union.num))

結果

Confusion Matrix and Statistics

          Reference
Prediction   0   1
         0 431  89
         1   7   7
                                         
               Accuracy : 0.8202         
                 95% CI : (0.785, 0.8519)
    No Information Rate : 0.8202         
    P-Value [Acc > NIR] : 0.5272         
                                         
                  Kappa : 0.0854         
                                         
 Mcnemar's Test P-Value : <2e-16         
                                         
            Sensitivity : 0.98402        
            Specificity : 0.07292        
         Pos Pred Value : 0.82885        
         Neg Pred Value : 0.50000        
             Prevalence : 0.82022        
         Detection Rate : 0.80712        
   Detection Prevalence : 0.97378        
      Balanced Accuracy : 0.52847        
                                         
       'Positive' Class : 0 

この二項ロジスティック回帰モデルの正確性82.02%であった。

ROC曲線 Receiver Operating Characteristic Curves

モデルがデータに合っているかどうかを判断するために使用できる視覚的な検査方法もいくつかある。ROC曲線は、感度(真陽性、すなわち、イベントとして正しく分類されたケースのパーセンテージ)と1-特異度(偽陽性、すなわち、イベントとして誤って分類されたケースのパーセンテージ)を比較する。したがって、ROC曲線は、ある割合の症例を正しく分類するために、誤分類される必要のある症例の割合を示している。ROC 曲線は、0.50以外のカット・ポイントを識別するためのバイナリ・ロジスティック回帰でも有用である。

AUC; Area Under the Receiver Operating Characteristic Curve

ROC曲線の主な限界は、ROC曲線は視覚的な検査しかできないため、データとモデルの適合に関する解釈が主観的であることである。しかし研究者は、ROC曲線を用いて曲線下面積(AUC)を計算することができる。AUCは、データ-モデル適合の尺度として使用できる単一の数値を報告することで、曲線を定量化する。概念的には、AUCは一致確率であり、無作為に選んだ陽性症例が無作為に選んだ別の陰性症例より高いスコアを出す確率である。曲線が左上隅に近いほど、AUCは大きい。二項ロジスティック回帰では、AUCは0.5 から 1.0の範囲で、値が高いほどデータ・モデルの適合がよいことを示す。AUC は、Wilcoxonの順位検定と同じ結果を生成する (Streiner & Cairney, 2007)。経験則として、AUC値が0.5~0.7は低いとみなされ、0.7~0.9は中程度、0.9より大きい値は高いとみなされる(Streiner & Cairney, 2007)。t検定は、AUCが0.5から統計的に有意に異なるかどうかを決定するために計算することができる。統計的に有意なAUC値は、モデルが偶然よりもよく適合していることを示す。研究者によっては、AUC推定値の周りの95%信頼区間を報告する。

データとモデルの適合の尺度としてROC曲線とAUCを用いることには多くの問題がある。第一に、感度と特異度の値はカットポイントがどこにあるかによって決まるため、AUCは無限に計算できる。さらに、ROC曲線は分散を考慮しておらず、ROC曲線が交差する可能性があるため、直接比較できないことから、モデル比較にROC曲線を使用することに注意を促す研究者もいる(Fawcett, 2005; Streiner & Cairney, 2007)。

注:AUCは要するに順序に関する計算であり、分散が考慮されないということ。

ROC曲線下面積(AUC)

正確性加えて、ROC曲線下面積(AUC)は、モデルの予測可能性を評価するために用いることができる。AUCが高いほど良いモデルである。

AUC曲線の計算を行う。

## 真の値と予測確率のデータフレームを作成する
eval_df <- data.frame(CPS1985$union.num, pred_probs)
colnames(eval_df) <- c("truth", "pred_probs")
eval_df$truth <- as.factor(eval_df$truth)

### AUCを計算する
library(yardstick)
roc_auc(eval_df, truth, pred_probs, event_level = "second")

結果

  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 roc_auc binary         0.755

AUCスコアは75.50%であった。

次に、ggplot2でROC曲線をプロットする。

library(yardstick)
library(ggplot2)
library(dplyr)

## plot ROC
roc_curve(eval_df, truth, pred_probs, event_level = "second") %>% 
    ggplot(aes(x = 1 - specificity, y = sensitivity)) +
    geom_path() +
    geom_abline(lty = 3, col = "red") + 
    coord_equal() +
    theme_bw()

フィッティングされたモデルのAUCは75.50%で、このモデルは予測可能性が高いことを示している。

予測確率のヒストグラム Histogram of Predicted Probabilities

最後に、予測確率のヒストグラム(分類プロットとも呼ばれる)と結果は、予測の質を調べるために使用できる。このヒストグラムは、視覚的に有益なグラフで、偽陽性のパーセント、偽陰性のパーセント、および正しい分類のパーセントを提供する。よく区別された予測を示すために、分類プロットは、次の特徴を持つべきである:(1) U字形(正規分布よりもむしろ)、(2) ケースがそれぞれの端に集まっている(すなわち、カット・ポイントからより離れている、通常、二項ロジスティック回帰では0.5)、(3) 分類における最小のエラー(すなわち、わずかな偽陽性とわずかな偽陰性)。ヒストグラムは、正しい分類のパーセンテージとグループ間の分離をグラフィカルに描写することによって、分類率の測定を補足する。残念ながら、AUCがROC曲線を定量化するように、このヒストグラムに含まれる情報を定量化する単一の数値は存在しない。

hist(fitted(fit))

順序ロジスティック回帰分析をStata、Mplus、Rで行う-更新[Stata][Mplus][R]

順序ロジスティック回帰分析をStata、Mplus、Rで行う

以前のエントリの更新。

ides.hatenablog.com

brant検定が通らない例を使っている。

Stata

brant検定が走らない場合はfindit spost13_adoからspost13_adoをインストールする必要がある。

use https://www3.nd.edu/~rwilliam/statafiles/ordwarm2.dta, clear
ologit warm yr89 male white age ed prst, robust
brant
Iteration 0:   log pseudolikelihood = -2995.7704  
Iteration 1:   log pseudolikelihood = -2846.4532  
Iteration 2:   log pseudolikelihood = -2844.9142  
Iteration 3:   log pseudolikelihood = -2844.9123  
Iteration 4:   log pseudolikelihood = -2844.9123  

Ordered logistic regression                             Number of obs =  2,293
                                                        Wald chi2(6)  = 281.80
                                                        Prob > chi2   = 0.0000
Log pseudolikelihood = -2844.9123                       Pseudo R2     = 0.0504

------------------------------------------------------------------------------
             |               Robust
        warm | Coefficient  std. err.      z    P>|z|     [95% conf. interval]
-------------+----------------------------------------------------------------
        yr89 |   .5239025   .0779223     6.72   0.000     .3711775    .6766275
        male |  -.7332997   .0785119    -9.34   0.000    -.8871803   -.5794192
       white |  -.3911595   .1173929    -3.33   0.001    -.6212454   -.1610735
         age |  -.0216655   .0024086    -8.99   0.000    -.0263864   -.0169447
          ed |   .0671728   .0160635     4.18   0.000     .0356889    .0986567
        prst |   .0060727   .0032978     1.84   0.066    -.0003908    .0125363
-------------+----------------------------------------------------------------
       /cut1 |  -2.465362     .23923                     -2.934244    -1.99648
       /cut2 |   -.630904   .2306956                     -1.083059   -.1787489
       /cut3 |   1.261854   .2322644                      .8066241    1.717084
------------------------------------------------------------------------------


Brant test of parallel regression assumption

              |       chi2     p>chi2      df
 -------------+------------------------------
          All |      49.18      0.000      12
 -------------+------------------------------
         yr89 |      13.01      0.001       2
         male |      22.24      0.000       2
        white |       1.27      0.531       2
          age |       7.38      0.025       2
           ed |       4.31      0.116       2
         prst |       4.33      0.115       2

A significant test statistic provides evidence that the parallel
regression assumption has been violated.

Mplus

RでSataのデータをMplus用に変換

library(rio)
ordwarm2 <- import("ordwarm2.dta")
ordwarm2.mplus <- subset(ordwarm2, select = 
                    c(warm, yr89, male, white, age, ed, prst))
library(MplusAutomation)
variable.names(ordwarm2.mplus) 
prepareMplusData(ordwarm2.mplus, filename="ordwarm2.mplus.dat", overwrite=T)

Mplus

TITLE: Ordinal Logistic Regression
DATA: FILE = "ordwarm2.mplus.dat";
VARIABLE: 
  NAMES = warm yr89 male white age ed prst; 
  USEVARIABLES = warm yr89 male white age ed prst; 
  CATEGORICAL = warm;
  MISSING=.;

ANALYSIS:
  ESTIMATOR = MLR; 
  
MODEL:
   warm on yr89 male white age ed prst
  
plot:
    type = plot3;

結果

MODEL RESULTS

                                                    Two-Tailed
                    Estimate       S.E.  Est./S.E.    P-Value

 WARM       ON
    YR89               0.524      0.078      6.725      0.000
    MALE              -0.733      0.078     -9.342      0.000
    WHITE             -0.391      0.117     -3.333      0.001
    AGE               -0.022      0.002     -8.997      0.000
    ED                 0.067      0.016      4.183      0.000
    PRST               0.006      0.003      1.842      0.065

 Thresholds
    WARM$1            -2.465      0.239    -10.308      0.000
    WARM$2            -0.631      0.231     -2.735      0.006
    WARM$3             1.262      0.232      5.434      0.000


LOGISTIC REGRESSION ODDS RATIO RESULTS

 WARM       ON
    YR89               1.689
    MALE               0.480
    WHITE              0.676
    AGE                0.979
    ED                 1.069
    PRST               1.006


BRANT WALD TEST FOR PROPORTIONAL ODDS

                                   Degrees of
                      Chi-Square     Freedom   P-Value

  WARM
    Overall test          49.181        12      0.000
    YR89                  13.013         2      0.001
    MALE                  22.238         2      0.000
    WHITE                  1.268         2      0.531
    AGE                    7.383         2      0.025
    ED                     4.310         2      0.116
    PRST                   4.332         2      0.115

R Ordinalパッケージ

subsetの作成

ordwarm2.R <- subset(ordwarm2, select = 
                   c(warm, yr89, male, white, age, ed, prst))

データ型の変更

ordwarm2.R$warm <- as.factor(ordwarm2.R$warm)
ordwarm2.R$warm <- factor(ordwarm2.R$warm, ordered = T, 
                           levels = c("1", "2", "3", "4"))
ordwarm2.R$male <- as.factor(ordwarm2.R$male)
ordwarm2.R$white <- as.factor(ordwarm2.R$white)

分析

library(ordinal)
res.R <-clm(formula = warm ~ yr89 + male + white + age + ed + prst, 
            link = "logit", Hess = TRUE, na.action = na.omit,
            data = ordwarm2.R)
summary(res.R)

結果

 link  threshold nobs logLik   AIC     niter max.grad cond.H 
 logit flexible  2293 -2844.91 5707.82 5(0)  4.94e-10 4.4e+05

Coefficients:
        Estimate Std. Error z value Pr(>|z|)    
yr89    0.523902   0.079899   6.557 5.49e-11 ***
male1  -0.733300   0.078483  -9.343  < 2e-16 ***
white1 -0.391159   0.118381  -3.304 0.000952 ***
age    -0.021666   0.002468  -8.778  < 2e-16 ***
ed      0.067173   0.015975   4.205 2.61e-05 ***
prst    0.006073   0.003293   1.844 0.065157 .  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Threshold coefficients:
    Estimate Std. Error z value
1|2  -2.4654     0.2389 -10.319
2|3  -0.6309     0.2333  -2.704
3|4   1.2619     0.2340   5.392

オッズ比での表示

library(tidymodels)
tidy(res.R, exponentiate = TRUE, conf.int = TRUE) |> 
  select(-c(std.error, statistic))

結果

  term   estimate  p.value conf.low conf.high coef.type
  <chr>     <dbl>    <dbl>    <dbl>     <dbl> <chr>    
1 1|2      0.0850 5.78e-25   NA        NA     intercept
2 2|3      0.532  6.85e- 3   NA        NA     intercept
3 3|4      3.53   6.96e- 8   NA        NA     intercept
4 yr89     1.69   5.49e-11    1.44      1.98  location 
5 male1    0.480  9.32e-21    0.412     0.560 location 
6 white1   0.676  9.52e- 4    0.536     0.853 location 
7 age      0.979  1.67e-18    0.974     0.983 location 
8 ed       1.07   2.61e- 5    1.04      1.10  location 
9 prst     1.01   6.52e- 2    1.00      1.01  location

brant検定

library(gofcat)
brant.test(res.R)

結果

Brant Test:
           chi-sq   df   pr(>chi)    
Omnibus     49.30   12    1.9e-06 ***
yr89        13.01    2     0.0015 ** 
male1       22.24    2    1.5e-05 ***
white1       1.27    2     0.5305    
age          7.38    2     0.0249 *  
ed           4.31    2     0.1159    
prst         4.33    2     0.1146    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

H0: Proportional odds assumption holds

最小二乗法を用いた重回帰分析の前提条件と確認方法

重回帰の前提は下記のものである。

  • 線形性 Linearity...予測変数と従属変数の残差間に線形関係が存在する。
  • 正規性 Normality ...残差が正規分布する。
  • 分散均一性 homoscedasticity ...残差は一定の分散を持つと仮定する
  • 独立性 Independence...観測変数が互いに独立である(多重共線性がない)。

AERパッケージに含まれるCPS1985データで確かめてみよう。

library(AER)
data(CPS1985)
head(CPS1985)
      wage education experience age ethnicity region gender occupation        sector union married
1     5.10         8         21  35  hispanic  other female     worker manufacturing    no     yes
1100  4.95         9         42  57      cauc  other female     worker manufacturing    no     yes
2     6.67        12          1  19      cauc  other   male     worker manufacturing    no      no
3     4.00        12          4  22      cauc  other   male     worker         other    no      no
4     7.50        12         17  35      cauc  other   male     worker         other    no     yes
5    13.07        13          9  28      cauc  other   male     worker         other   yes      no

重回帰分析

mod <- lm(wage ~ gender + age + education, data = CPS1985)
summary(mod)

前提条件の検証

QQプロットを作成する。 QQプロット(分位点-分位点プロット)のことであり、正規性の仮定を検証するために使用される。 あるデータ集合が正規分布や指数分布のような理論的分布に由来しているかどうかを評価するためのグラフである。例えば、残差が正規分布していると仮定して統計分析を行った場合、正規QQプロットを使ってその仮定をチェックすることができる。

QQプロットを作成するにはMosaicのqqmath関数を使用する。 点("p")と線("r")を追加するには、qqmath関数の引数にそれぞれを指定する。

library(mosaic)
qqmath(~resid(mod), type = c("p","r"))

両端に外れ値があるものの、プロットの全体のフィッティングは非常によい。QQ-プロットから正規性の仮定が有効であることがわかる。

線形性と分散均一性の検証

フィット値プロットを得るにはネイティブのR plot関数を使用する。

plot(mod , which = 1)

適合値プロットでは、(モデルを使った)適合値と残差を比較する。線形性の仮定が満たされている場合、適合値プロットは、ほぼ水平な適合線を持つことになる(たとえば、y=0を中心にランダムに散らばっている)。このプロットでは、赤い線が点線y=0にかなり近いことから、線形性の仮定を確認することができる。

分散均一性も同一のプロットでみる。残差と、残差対予測値(つまりフィッティング値)のプロットにおいて、残差と予測値の関数より広がっている場合に、分散均一性は仮定できない。

分散均一性を検討するのにはBreusch-Pagan検定を使う手がある。

Breusch-Pagan検定

計算ができるパッケージはいくつかある。ここでは、carとlmtestでやっておこう。

library(car)
bp_test <- car::ncvTest(mod)
print(bp_test)
Non-constant Variance Score Test 
Variance formula: ~ fitted.values 
Chisquare = 40.51078, Df = 1, p = 1.9553e-10
library(lmtest)
lmtest::bptest(mod)
 studentized Breusch-Pagan test

data:  mod
BP = 9.1069, df = 3, p-value = 0.0279

帰無仮説は「残差は等しい分散で分布する」であり、p値が0.05より大きくなければならないため、Breusch-Pagan検定では分散均一性を仮定できない。

手続き的には分散均一性を仮定できない場合には、ロバスト推定を行うことになる。

ロバスト推定を行う

library(MASS)
mod.robust <- rlm(wage ~ gender + age + education, data = CPS1985)
summary(mod.robust)
Coefficients:
             Value   Std. Error t value
(Intercept)  -4.6060  1.0236    -4.4999
genderfemale -2.3399  0.3192    -7.3297
age           0.1171  0.0137     8.5281
education     0.7701  0.0614    12.5448

Residual standard error: 3.543 on 530 degrees of freedom

このロバスト回帰モデルが、OLSモデルと比較して、データへのより良い適合を提供するかどうかを決定するために、各モデルの残差標準誤差を計算することができる。残差標準誤差(residual standard error: RSE)は,回帰モデルの残差の標準偏差を測定する方法であり、RSE の値が低いほど、モデルがデータに適合的である。

## OLSモデルの残差標準誤差を求める
summary(mod)$sigma
## ロバスト推定したモデルの残差標準誤差を求める
summary(mod.robust)$sigma

ロバスト回帰モデルのRSEは、通常の最小2乗回帰モデルよりも低い。これは、ロバスト回帰モデルがデータによりよく適合していることを示している。

現代人に広まる「デジタルため込み症」 自己診断のための10項目(Forbes)

forbesjapan.com

元論文 - Wang, H., Miao, P., Jia, H., & Lai, K. (2023). The Dark Side of Upward Social Comparison for Social Media Users: An Investigation of Fear of Missing Out and Digital Hoarding Behavior. Social Media + Society, 9(1), 205630512211504. https://doi.org/10.1177/20563051221150420

元論文SNSの話をしている。

デジタル時代になり、デジタルファイルを溜め込み、ストレスや障害を引き起こす行動と定義されるデジタル・ホーディング行動が増加している。しかし、デジタル・ホーディングの原因や心理的カニズムについてはほとんど知られていない。この研究ギャップを解決するために、本研究では、ソーシャル・ネットワーキング・サイト(SNS)利用者のデジタル・ホーディング行動の原因と心理的動機づけに関するモデレート媒介モデルを提案し、オンライン質問紙法を用いて実証的に検証した。SNS利用者計556名を対象にオンライン調査を行った。その結果、この種の社会的比較が個人のデジタル・ホーディング行動を増加させ、この効果を逃すことへの恐れ(FoMO)が媒介することが明らかになった。さらに、この比較とFoMOの関係、およびFoMOとデジタル・ホーディング行動の関係は、特性的貪欲さが高いSNSユーザーほど強くなるように、特性的貪欲さが調節していた。本研究は、SNSを介した上方比較とデジタル・ホーディング行動との関係における作用心理学的メカニズムや境界条件の理解を深めるものである。

特性的貪強欲 dispositional greed が調整moderateしていたようだ。

オーヴェリティについてのまとめ

日本語で紹介した記事。

www.harpersbazaar.com

昨年、簡単なエントリをしている。

ides.hatenablog.com

オーヴェリティは日本で発売されていないが、デキストロメトルファンメジコンとして発売されており、ブプロピオンは個人輸入できるため、容量は合わせることは難しいが疑似的に再現は可能である。
オーヴェリティの機序や服薬方法などをまとめた。
メジコンは昨今、悪いように注目を集めることが多い薬剤だけに、オーヴェリティのことを調べているといろいろと発見がある。ケタミンと類似した効果があるため、使い方さえ間違えなければ、使いどころがありそうな薬である。

治療成績

DextromethorphanはN-メチル-D-アスパラギン酸受容体の非競合的拮抗作用とシグマ-1作動作用によりグルタミン酸シグナル伝達を調節し、bupropionはCYP2D6阻害作用によりDextromethorphanの生物学的利用能を増加させる。大うつ病性障害患者を対象としたdextromethorphan-bupropion 45-105mgの第3相試験では、プラセボと比較してMontgomery-Åsbergうつ病評価尺度(Montgomery-Åsberg Depression Rating Scale)の総スコアが有意に低下した。dextromethorphan-bupropion 45-105mgとブプロピオン単剤療法を比較した第2相試験では、Montgomery-Åsbergうつ病評価尺度スコアが有意に低下した。dextromethorphan-bupropion によるMontgomery-Åsberg Depression Rating Scaleの変化は、いずれの臨床試験においても2週間以内に認められた。寛解率と奏効率は、両試験ともdextromethorphan-bupropionの方が有意に高かった。両試験とも忍容性は良好で、最も一般的な有害事象は軽度から中等度であった。dextromethorphan-bupropion を用いた2つの長期非盲検試験では、Montgomery-Åsbergうつ病評価尺度スコアの大幅な減少が認められ、治療開始後12ヵ月および15ヵ月まで維持された。いずれの長期試験においても、寛解率は70%に近づき、奏効率は80%以上であった。これらのデータから、dextromethorphan-bupropionはうつ病治療において有効で即効性があり、忍容性の高い選択肢であり、多くの患者で寛解が得られたことが示唆される。
https://www.cpn.or.kr/journal/view.html?doi=10.9758/cpn.23.1081

  • McCarthy, B., Bunn, H., Santalucia, M., Wilmouth, C., Muzyk, A., & Smith, C. M. (2023). Dextromethorphan-bupropion (Auvelity) for the Treatment of Major Depressive Disorder. Clinical Psychopharmacology and Neuroscience, 21(4), 609–616. https://doi.org/10.9758/cpn.23.1081

機序

オーヴェリティは、N-メチル-d-アスパラギン酸(NMDA)受容体拮抗薬デキストロメトルファン(45mg)とノルエピネフリンドパミン再取り込み阻害薬ブプロピオン(105mg)を配合した薬剤である[4]。デキストロメトルファンはチトクロームP450 2D6(CYP2D6)で速やかに代謝されるため、経口投与でデキストロメトルファンの治療レベルを達成することは困難であり、CYP2D6阻害薬であるブプロピオンがデキストロメトルファンとともに添加されるのはこのためである[4]。オーヴェリティは、複数の異なる抗うつ療法の作用機序を1つにまとめたものである [4] 。デキストロメトルファンとブプロピオンはともに、ノルエピネフリンの再取り込みを阻害することによってノルエピネフリンの利用可能性を増加させ、α-4-β2ニコチン(nACh)拮抗薬としても作用する [4] 。ブプロピオンもまた、再取り込みを阻害することにより、ドーパミンの利用可能性を増加させる [4] 。デキストロメトルファンは、NMDA受容体拮抗薬として作用し、グルタミン酸レベルを増加させる。また、再取り込みを阻害し、シグマ-1アゴニズムを介して背側葉での作用を高めることにより、セロトニンレベルを増加させる [3]。
https://www.ncbi.nlm.nih.gov/pmc/articles/PMC9577655/

服薬について

  • オーヴェリティの錠剤は丸呑みして下さい。錠剤を砕いたり、噛んだり、分割したりしないで下さい。
  • オーヴェリティは、食事の有無にかかわらず服用できます。
  • オーヴェリティを1日1回、3日間服用した後、1日2回に増量する(少なくとも8時間間隔で服用する)。
  • 24時間に2錠以上服用しないで下さい。
  • 飲み忘れた場合、飲み忘れた分を補うために追加服用しないでください。次の服用は定時に行って下さい。一度に1回分以上の服用はしないで下さい。

自殺念慮および自殺行為のリスクの増加。オーヴェリティおよび他の抗うつ薬は、一部の小児、青年、若年成人において、特に治療開始後数ヵ月以内または用量を変更した場合に、自殺念慮および自殺行動を増加させることがある。オーヴェリティは小児には使用できません。

以下の場合は、オーヴェリティを服用しないこと:

  • てんかん発作を起こしたことがある
  • 神経性食欲不振症や過食症などの摂食障害がある、またはあった人
  • 最近急に飲酒をやめた、またはベンゾジアゼピン系、バルビツール系、抗けいれん薬と呼ばれる薬を使用していて、最近急に服用をやめた。
  • モノアミン酸化酵素阻害薬(MAOI)の服用
  • 過去14日以内にMAOIの服用を中止したことがある。
  • 抗生物質リネゾリドまたはメチレンブルーの静脈内投与を受けている患者
  • デキストロメトルファン、ブプロピオン、またはオーベルティの成分に対してアレルギーのある人。

抗生物質のリネゾリドやメチレンブルーの静脈内投与を含め、MAOIやこれらの薬のいずれかを服用しているかわからない場合は、医療提供者または薬剤師に尋ねてください。
過去14日間にMAOIの服用を中止した場合は、オーヴェリティを開始しないでください。
AUVELITYによる治療を中止してから少なくとも14日間は、MAOIの服用を開始しないでください。


オーベリティの最も一般的な副作用は以下の通りである:

  • めまい
  • 頭痛
  • 下痢
  • ねむい
  • 口渇
  • 多汗
  • 性機能障害

https://dailymed.nlm.nih.gov/dailymed/medguide.cfm?setid=dcefda7c-9a68-278e-e053-2995a90aec79

アルツハイマー認知症への応用

アルツハイマー病は高齢者が罹患する最も一般的な認知症である。アルツハイマー病はまた、大うつ病性障害と有意な関連を示す。NMDA受容体を介したグルタミン酸作動性興奮毒性は、アルツハイマー病における神経変性の根底にある重要な機序であると考えられている。メマンチンのようなNMDA拮抗薬によるNMDA受容体の遮断は、グルタミン酸作動性興奮毒性を抑制するようである。メマンチンはまた、シグマ-1受容体の作動を介してドーパミン作動性の活性化を増加させる。これら2つの機序の組み合わせが、メマンチンによるAD患者の記憶、認知、一般機能の改善の背景にあると考えられている。オーヴェリティは最近、成人の大うつ病性障害の治療薬としてFDAから承認された。オーヴェリティの作用機序は、NMDA受容体の遮断とそれに伴うグルタミン酸作動性神経伝達経路の拮抗作用、およびシグマ-1受容体の作動作用の組み合わせである。オーヴェリティとメマンチンのようなAD治療薬は同じ作用機序であることから、オーヴェリティはアルツハイマー病の症状を軽減する治療薬になりうると考えられている。
https://esmed.org/MRA/index.php/mra/article/view/3206

Ordinalパッケージを用いた順序ロジスティック回帰分析

quantifyinghealth.com

注:動作しないコードを書き換え、不足しているものに関して注という形で補完している。

順序ロジスティック回帰は、1つまたは複数の予測変数(数値またはカテゴリ)と順序結果の間の関係をモデルする回帰分析の一種だ。順序結果は、次のような論理的順序を持つ2つ以上のカテゴリを持つ変数である:

  • 癌のステージ:0、1、2、3、4
  • 所得レベル:低、中、高

このチュートリアルでは、GitHubのリンクからダウンロードできる(https://github.com/datasciencedojo/datasets/blob/master/titanic.csv)。

注:ここではtitanicパッケージのtitanic_trainデータを使用する。

titanicデータセットで順序ロジスティック回帰を使い、予測変数Pclass(乗客クラス)を予測する:Pclassは、3つの値(1: first class, 2: second class, 3: third class)のうちの1つを取ることができる: 予測変数:年齢(Age)、性別(Sex)、生存(Survived)。

library(titanic)
titanic.raw <-titanic_train
## サブセットを作成
titanic <- subset(titanic.raw, select = c(Pclass, Age, Sex, Survived))

## Pclassにレベルをつける
titanic$Pclass <- factor(titanic$Pclass, levels = c(3, 2, 1), 
                         labels = c("1st", "2nd", "3rd"), ordered = TRUE)
titanic$Sex <- factor(titanic$Sex)
titanic$Survived <- factor(titanic$Survived, 
                           labels = c("Died", "Survived"))
str(titanic)
'data.frame':    891 obs. of  4 variables:
 $ Pclass  : Ord.factor w/ 3 levels "1st"<"2nd"<"3rd": 1 3 1 3 1 1 3 1 1 2 ...
 $ Age     : num  22 38 26 35 35 NA 54 2 27 14 ...
 $ Sex     : Factor w/ 2 levels "female","male": 2 1 1 1 2 2 2 2 1 1 ...
 $ Survived: Factor w/ 2 levels "Died","Survived": 1 2 2 2 1 1 1 1 2 2 ...

2. 順序ロジスティック回帰モデルのフィッティング

我々は、順序ロジスティック回帰の最も一般的なタイプである比例オッズ・ロジスティック回帰を使用する。

このモデルは、ordinal パッケージのclm()関数を用いて、下記のように実行できる:

library(ordinal)
model <- clm(Pclass ~ Age + Sex + Survived, data = titanic, na.action = na.omit)
summary(model)
Coefficients:
                 Estimate Std. Error z value Pr(>|z|)    
Age              0.063208   0.005857  10.792   <2e-16 ***
Sexmale          0.315159   0.199921   1.576    0.115    
SurvivedSurvived 1.969870   0.204830   9.617   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Threshold coefficients:
        Estimate Std. Error z value
1st|2nd   2.8120     0.2838    9.91
2nd|3rd   4.2024     0.3091   13.60

na.actionはリストワイズを意味するna.omit、na.excludeは(予測値、標準誤差、区間限界において)残差値NAと表示される。

各予測変数と結果の関係の解釈

予測変数 X1 に関連づけられた順序ロジスティック回帰係数 β1 の一般的な解釈は,次式である.

予測変数X1が1単位増加すると,結果Yがより高いカテゴリーにあることの対数オッズがβ1変化する.

予測変数の係数は対数オッズ比なので、オッズ比を得るためには指数化しなければならない。

Rでは、係数とp値を抽出するために、モデル・フィットの関数tidy()を、引数exponentiate = TRUEとconf.int = TRUE(95%信頼区間を表示する)で呼び出すことができる。そして、表を小さくするために、出力から標準誤差とzスコアを取り除く:

library(tidymodels)
tidy(model, exponentiate = TRUE, conf.int = TRUE) |> 
  select(-c(std.error, statistic))
  term             estimate  p.value conf.low conf.high coef.type
  <chr>               <dbl>    <dbl>    <dbl>     <dbl> <chr>    
1 1st|2nd             16.6  3.77e-23   NA         NA    intercept
2 2nd|3rd             66.8  4.17e-42   NA         NA    intercept
3 Age                  1.07 3.77e-27    1.05       1.08 location 
4 Sexmale              1.37 1.15e- 1    0.930      2.04 location 
5 SurvivedSurvived     7.17 6.77e-22    4.83      10.8  location 

我々は、予測変数の係数(最後の3行)のみを見て、切片は見ない。以下は、その解釈方法 である:

年齢の係数の解釈:

年齢に関する指数係数(オッズ比)は1.07である。年齢が高いことは、より高い客室であることと正の関係があり、解釈は次のようになる:

年齢が高い乗客は、より高いクラスのチケットを持つ傾向がある(p < 0.001)。具体的には、1歳上の乗客は、1.07倍高い確率で、1クラス高い客室のチケットを持つ。

Sexの係数の解釈:

男性のSexに関する指数係数(オッズ比)は統計的に有意ではない(p = 0.115)。

生存率の係数の解釈

Survivedの指数係数(オッズ比)7.17である。

生存した乗客は、より高いクラスのチケットを持っている傾向がある(p < 0.001)。具体的には、生存した乗客は、生存しなかった乗客よりも7.17倍の高い確率で1クラス上の航空券を持っていた。

モデル適合のチェック

rcompanionパッケージの関数nagelkerke()は、擬似R2乗を計算し、尤度比検定を実行する:

library(rcompanion)
nagelkerke(model)
$Models
                                                    
Model: "clm, Pclass ~ Age + Sex + Survived, titanic"
Null:  "clm, Pclass ~ 1, titanic"                   

$Pseudo.R.squared.for.model.vs.null
                             Pseudo.R.squared
McFadden                             0.155862
Cox and Snell (ML)                   0.277186
Nagelkerke (Cragg and Uhler)         0.316640

$Likelihood.ratio.test
 Df.diff LogLik.diff  Chisq   p.value
      -3     -115.88 231.77 5.738e-50

$Number.of.observations
          
Model: 714
Null:  714

$Messages
[1] "Note: For models fit with REML, these statistics are based on refitting with ML"

$Warnings
[1] "None"

特に重要なのは、
NagelkerkeのR2乗: ロジスティック回帰モデルの適合度を測定する0から1の間の数値である。 尤度比検定: フル・モデル(すべての予測変数を含むモデル)がヌル・モデル(変数を含まないモデル)よりもよくデータに適合するかどうかを検定する。我々の事例では、LogLik.diffは-115.88で、p < 0.001であり、これは予測変数を追加することが予測変数を含まない帰無モデルよりもよいことを意味する。

 注

nagelkerkeの疑似R二乗を用いた尤度比検定は行わない方が良いと思われる。一つはnagelkerkeの疑似R二乗が通常のR二乗とは異なるということ、もう一つはR二乗はがモデルのフィッティングを示す指標としては不適切であるためである。
参考:
https://ides.hatenablog.com/entry/2022/05/06/165738
https://ides.hatenablog.com/entry/2022/06/19/030458

また、lipsitz検定を実行して適合度をチェックすることもできる:

library(generalhoslem)
lipsitz.test(model)
Lipsitz goodness of fit test for ordinal response models

data:  formula:  Pclass ~ Age + Sex + Survived
LR statistic = 5.2796, df = 9, p-value = 0.8093

帰無仮説は、指定されたモデルがデータによく適合する。5%水準以下の小さなP値は、モデルが不完全であることを示唆する。つまり、我々のモデルはデータに適合している。

リプシッツ検定は、順序対応ロジスティック回帰モデルの適合度検定である。これは、順序応答スコアに基づいて、観察されたデータを等しい大きさのg群に分割することを含む。このスコアは、各結果水準での各被験者の予測確率に等間隔の整数の重みを掛けて合計することにより計算される。ユーザーは、デフォルトでは10であるgに整数値を代入して、グループの数を指定できる。

データのこの分割が与えられると、各グループについて、被験者が領域gにあればI = 1、なければI = 0となるようなダミー変数Iが導かれる。そして、モデルをこれらのダミー変数で再フィットする。Lipsitz ら (1996) は、尤度比検定、Wald 検定、スコア検定が使用できることを示唆している; lipsitz.test は、自由度 g-1 の尤度比検定を使用するだけである。

モデルを実行する前に、結果変数を因子に変換しなければならないことに注意してほしい。モデル関数内で as.factor() を使用すると、 lipsitz.test がモデルを再適合するために update() 関数を使用する方法のため、エラーが発生する。

Lipsitz 検定は、順序Hosmer-Lemeshow 検定(logitgof)とPulkstenis-Robinson 検定(pulkrob.chisq と pulkrob.deviance)と一緒に実行することが推奨さ れる(Fagerland and Hosmer, 2016)。

https://www.rdocumentation.org/packages/generalhoslem/versions/1.3.4/topics/lipsitz.test

注:Pulkstenis-Robinson 検定

帰無仮説は、指定されたモデルがデータによく適合する。5%水準以下の小さなP値は、モデルが不完全であることを示唆する。 c("Sex","Survived")のところはカテゴリカル変数を指定する必要がある。

pulkrob.chisq(model, c("Sex","Survived"))
 Pulkstenis-Robinson chi-squared test

data:  formula:  Pclass ~ Age + Sex + Survived
X-squared = 28.637, df = 11, p-value = 0.002583
pulkrob.deviance(model, c("Sex","Survived"))
 Pulkstenis-Robinson deviance test

data:  formula:  Pclass ~ Age + Sex + Survived
Deviance-squared = 28.448, df = 11, p-value = 0.002763

注:Hosmer-Lemeshow検定

帰無仮説は、指定されたモデルがデータによく適合する。5%水準以下の小さなP値は、モデルが不完全であることを示唆する。

## 欠損地を削除してtitanic.na.omitに格納
titanic.na.omit <- na.omit(titanic) 

## 従属変数のみのデータをpredprobに格納
predprob <- data.frame(Age = titanic.na.omit$Age, Sex = titanic.na.omit$Sex, Survived = titanic.na.omit$Survived)

## フィットさせたオブジェクトmodelから必要なものをfvに格納
fv <- predict(model, newdata = predprob, type = "prob")$fit

## Hosmer-Lemeshow検定を実行,従属変数、フィットさせたオブジェクト、従属変数のカテゴリー数、順序変数かどうかを指定する。
logitgof(titanic.na.omit$Pclass, fv, g = 3, ord = TRUE)
     Hosmer and Lemeshow test (ordinal model)

data:  titanic.na.omit$Pclass, fv
X-squared = 3.5784, df = 3, p-value = 0.3107

順序ロジスティック回帰モデルの精度

次に、3つのステップでモデルの精度を計算する:

ステップ#1: フィット値を取得し、predsに保存する:

注:ここではbroomパッケージのaugment()を用いる。

preds <- augment(model, type = "class", na.action="na.omit")
preds
# A tibble: 714 × 6
   .rownames Pclass   Age Sex    Survived .fitted
   <chr>     <ord>  <dbl> <fct>  <fct>    <fct>  
 1 1         1st       22 male   Died     1st    
 2 2         3rd       38 female Survived 3rd    
 3 3         1st       26 female Survived 3rd    
 4 4         3rd       35 female Survived 3rd    
 5 5         1st       35 male   Died     1st    
 6 7         3rd       54 male   Died     3rd    
 7 8         1st        2 male   Died     1st    
 8 9         1st       27 female Survived 3rd    
 9 10        2nd       14 female Survived 1st    
10 11        1st        4 female Survived 1st  

ステップ2:混同行列を見る:

注:yardstickのconf_mat()を用いる。

conf_mat(preds, truth = Pclass, estimate = .fitted)
          Truth
Prediction 1st 2nd 3rd
       1st 306 114  73
       2nd   0   0   0
       3rd  49  59 113

このモデルは、2等席のチケットを持っている人を分類していないことに注意してほしい。

ここで停止して、混同行列を用いて手動で精度を計算することもできますが、yardstickのaccuracy()関数を用いるとより速く計算できるでしょう。

ステップ3: モデルの精度を計算する:

yardstick::accuracy(preds, truth = Pclass, estimate = .fitted)
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 accuracy multiclass     0.587

つまり、年齢、性別、生存率に基づいて、モデルは乗客のクラスを58.7%の確率で正しく推測していることになる。

比例オッズの仮定のチェック

上記の順序ロジスティック回帰モデルの特定のタイプ(比例オッズ・ロジスティック回帰)は、結果での各予測変数の効果が結果のすべてのレベルについて同じであると仮定している。たとえば、2等席のチケット vs 1等席のチケットを持つオッズでの年齢の1歳増加の効果は、3等席のチケット vs 2等席のチケットを持つオッズでの年齢の1歳増加の効果と同じといったものだ。

ここで帰無仮説は、比例オッズの仮定が成り立つというものです。帰無仮説は,比例オッズの仮定が成り立つというものである.オムニバス検定でp < 0.05と変数の少なくとも1つが重なると,仮定が破られたとみなされる[source: McNulty K. Handbook of Regression Modeling in People Analytics: With Examples in R and Python. 第1版。Chapman and Hall/CRC; 2021.].

library(gofcat)
brant.test(model)
Brant Test:
                    chi-sq   df   pr(>chi)
Omnibus              3.699    3       0.30
Age                  2.027    1       0.15
Sexmale              1.554    1       0.21
SurvivedSurvived     0.679    1       0.41

H0: Proportional odds assumption holds

ここでは、すべてのp値が0.05を超えているので、比例オッズの仮定が成り立つ。

きょうの健康でゲーム行動症について誤った解説がされる

きょうの健康 “幸せホルモン”でストレス解消 「ゲームをするなら“黙々系”」

www.nhk.jp

きょうの健康といえば、ガッテン!(https://www.nhk.jp/p/gatten/ts/1ZQ6NXVY46/)などとは違い、確かな健康情報を伝えるというコンセプトの番組である。

日々の健康づくりに役立つ情報をお届けする「きょうの健康」。 がんや心臓病など命を奪うおそれのある病気から、効果的な運動や体操の方法まで、確かな取材に基づいた信頼のおける医学・健康の最新情報を、第一線で活躍する医師・専門家の方々をゲストに迎え、分かりやすくお伝えしますhttps://www.nhk.jp/p/kyonokenko/ts/83KL2X1J32/

番組初めからエセ科学全開である。

番組のディレクターが企画を考えて学者がそれに乗っかったのか、学者がディレクターをだましたのかわからないが、残念さしか残らないフリップである。

ゲーム障害

NHKのナレーションは以下。

ドパミンは欲求や快感を司っています。そのため、毎日何時間もゲームを続けていると、ゲームをしたいという欲が抑えられなくなってしまって、ゲーム障害になりやすくなってしまいます。そうなると、ひきこもりになったり、治療に長期間かかるなど生活への支障が大きくなりやすいそうです。ゲーム障害にならないためにはどんなゲームでも目安は1日30分程度が勧められます。

ドパミンは欲求や快感を司っています

ドーパミンは欲求や開花に関係をしているという意味であれば正しい。しかし、後に続く説明と整合的に理解すると、ドパミンが欲求や快感を引き起こしているという意味で使われているので、誤りである。

ides.hatenablog.com

James Oldsが1956年に書いた"Pleasure Centers in the Brain"で主張したメカニズムで、後年、否定されている。いつまで70年くらい前のドーパミン理解をしているのだろうか。

毎日何時間もゲームを続けていると、ゲームをしたいという欲が抑えられなくなってしまって、ゲーム障害になりやすくなってしまいます。

「なりやすくなる」という逃げ道を残しているが、長時間ゲームをし続けるとゲーム行動症になるという因果関係は証明されていない。もともとゲーム行動症といわれる状態になりやすい因子である、ADHDうつ病、不安症などの説明力を除いて、ゲームをすることがゲーム行動症につながると示した論文がないからだ。

端的にエビデンスがない。

ひきこもりになったり、治療に長期間かかるなど生活への支障が大きくなりやすいそうです

ゲームをやったら恐ろしいことになる、と脅しているが、ひきこもりがゲームのせいか、などわからない。例えば、不登校になって、家でやることがないのでゲームを長時間しているというのはよくあるケースだ。これをゲームのせいだ!というのは因果が逆転しているように思うのだが、どうだろうか。

ゲーム障害にならないためにはどんなゲームでも目安は1日30分程度が勧められます

端的にエビデンスがない。

先述のADHDなどの併存症の影響を取り除いて、ゲーム時間が30分ならゲーム行動症になりにくい、という結果を出している論文はないはず。

ゲーム行動症になりやすい背景を持った子が長時間ゲームをする傾向があり、併存症の発症や社会でのつまづきなどの要因でゲーム時間が長くなり、ゲーム行動症と呼ばれる状態になっているというのが、現在までの研究で分かっているメカニズムである。

ゲーム時間が30分以内の子がゲーム行動症になる確率が著しく低いという結果はある。しかし、これらの研究は、ゲーム時間を30分以内に収めればゲーム行動症にならない、と解釈するのは間違いである。

監修として出てくる三村将先生の個人的主観にすぎず、科学的研究の結果ではないことを明言すべきである。

三村将先生

こちらのデータベースで研究は確認できる。

www.k-ris.keio.ac.jp

ここに掲載されている論文で、ファーストの論文がまったくないので、データベースを漁ったところ、脳の研究者であるというのは間違いなさそうだ。

久里浜の樋口進先生とも和文、英文とも共著がいくつかあるので、一つずつ挙げておこう

www.dovepress.com

  • ElSalhy, M., Miyazaki, T., Noda, Y., Nakajima, S., Nakayama, H., Mihara, S., Kitayuguchi, T., Higuchi, S., Muramatsu, T., & Mimura, M. (2019). Relationships between Internet addiction and clinicodemographic and behavioral factors. Neuropsychiatric Disease and Treatment, Volume 15, 739–752. https://doi.org/10.2147/NDT.S193357

webview.isho.jp

  • ムハンマド・エルサルヒ,村松太郎,樋口進,三村将(2016)インターネット依存の概念と治療.Brain and nerve,68(10):1159-1166