#属性: 4つ（各3水準） #サンプルサイズ: 650人 #タスク: 全36問を3ブロックに分割。1人あたり12問に回答。 #選択肢: 1タスクあたり2つ回答者数

必要なパッケージを読み込む

library(logitr)
## Version:  1.1.2
## Author:   John Paul Helveston (George Washington University)
## 
## Consider submitting praise at
## https://github.com/jhelvy/logitr/issues/8.
## 
## Please cite the JSS article in your publications, see:
## citation("logitr")
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

— 1. シミュレーション設定 —

n_respondents <- 650   # ★回答者数650に設定した場合
n_tasks_total <- 36    # 全タスク数
n_alts        <- 2     # 1タスクあたりの選択肢数
n_blocks      <- 3     # ブロック数
n_tasks_per_resp <- n_tasks_total / n_blocks # 1人あたりタスク数 (12問)

— 2. マスター実験計画の作成 —

master_design <- tibble(
  taskID = rep(1:n_tasks_total, each = n_alts),
  blockID = rep(1:n_blocks, each = n_tasks_per_resp * n_alts)
) %>%
  mutate(
    congestion = sample(c("low", "mid", "high"), n_tasks_total * n_alts, replace = TRUE),
    price      = sample(c("base", "mid", "high"), n_tasks_total * n_alts, replace = TRUE),
    distance   = sample(c("short", "mid", "long"), n_tasks_total * n_alts, replace = TRUE),
    review     = sample(c("low", "mid", "high"), n_tasks_total * n_alts, replace = TRUE)
  )

— 3. 回答者を各ブロックにランダムに割り当て —

respondent_blocks <- tibble(
  respID = 1:n_respondents,
  blockID = sample(1:n_blocks, n_respondents, replace = TRUE)
)

— 4. シミュレーション用の全データセットを生成 —

sim_data <- respondent_blocks %>%
  left_join(master_design, by = "blockID") %>%
  mutate(obsID = group_indices(., respID, taskID))
## Warning in left_join(., master_design, by = "blockID"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 1 of `x` matches multiple rows in `y`.
## ℹ Row 1 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.
## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `obsID = group_indices(., respID, taskID)`.
## Caused by warning:
## ! The `...` argument of `group_indices()` is deprecated as of dplyr 1.0.0.
## ℹ Please `group_by()` first

— 5. “ランダムロボット”による回答を生成 —

random_choices <- sim_data %>%
  group_by(obsID) %>%
  sample_n(1) %>%
  mutate(choice = 1) %>%
  ungroup()
sim_data <- sim_data %>%
  left_join(random_choices, by = colnames(sim_data)) %>%
  mutate(choice = ifelse(is.na(choice), 0, 1))

— 6. モデルのためのデータ準備（参照カテゴリの設定）—

各属性を因子(factor)型に変換し、参照カテゴリをレベルの1番目に指定する

model_data <- sim_data %>%
  mutate(
    congestion = factor(congestion, levels = c("low", "mid", "high")),
    price      = factor(price, levels = c("base", "mid", "high")),
    distance   = factor(distance, levels = c("short", "mid", "long")),
    review     = factor(review, levels = c("low", "mid", "high"))
  )

— 7. 多項ロジットモデルで分析 —

ref_level引数を削除し、準備したmodel_dataを使用する

mnl_model <- logitr(
  data      = model_data,
  outcome   = "choice",
  obsID     = "obsID",
  panelID   = "respID",
  pars      = c("congestion", "price", "distance", "review")
)
## Running model...
## Done!

— 8. 結果の確認 —

summary(mnl_model)
## =================================================
## 
## Model estimated on: 月 10 27 8:09:44 2025 
## 
## Using logitr version: 1.1.2 
## 
## Call:
## logitr(data = model_data, outcome = "choice", obsID = "obsID", 
##     pars = c("congestion", "price", "distance", "review"), panelID = "respID")
## 
## Frequencies of alternatives:
##       1       2 
## 0.50269 0.49731 
## 
## Exit Status: 3, Optimization stopped because ftol_rel or ftol_abs was reached.
##                                 
## Model Type:    Multinomial Logit
## Model Space:          Preference
## Model Run:                1 of 1
## Iterations:                    9
## Elapsed Time:        0h:0m:0.03s
## Algorithm:        NLOPT_LD_LBFGS
## Weights Used?:             FALSE
## Panel ID:                 respID
## Robust?                    FALSE
## 
## Model Coefficients: 
##                  Estimate Std. Error z-value Pr(>|z|)
## congestionmid  -0.0233073  0.0445673 -0.5230   0.6010
## congestionhigh  0.0455735  0.0436558  1.0439   0.2965
## pricemid       -0.0047812  0.0333449 -0.1434   0.8860
## pricehigh       0.0114725  0.0459016  0.2499   0.8026
## distancemid     0.0814176  0.0495666  1.6426   0.1005
## distancelong   -0.0471270  0.0447266 -1.0537   0.2920
## reviewmid      -0.0415336  0.0515355 -0.8059   0.4203
## reviewhigh     -0.0115828  0.0560060 -0.2068   0.8362
##                                      
## Log-Likelihood:         -5.399120e+03
## Null Log-Likelihood:    -5.406548e+03
## AIC:                     1.081424e+04
## BIC:                     1.086993e+04
## McFadden R2:             1.373964e-03
## Adj McFadden R2:        -1.057230e-04
## Number of Observations:  7.800000e+03

install.packages(“rmarkdown”) rmarkdown::render(“理想サンプル数のパワー計算”)

#std.Error<0.05ならば十分なサンプル数

```