43. 項目反応理論 (IRT) 基礎

• このセクションで使っている packages

library(DT)
library(glpkAPI)
library(irt)
library(irtoys)
library(ltm)
library(plink)
library(plyr)
library(psych)
library(reactable)
library(tidyverse)

1. 項目反応理論 (IRT) の概要

1.1 項目反応理論でわかること

「学力を数値化する測定の理論」

• 項目反応理論 (Item Response Theory: IRT) とはテスト理論 (test theory) の一つ
  
• 大規模能力試験の作成・運用におけるグローバル・スタンダード
• テスト理論は計量心理学（psychometrics）を軸に体系化されてきた
  
• 項目（＝問題）に対する反応を統計モデル（確率モデル）で表現する手法
  
• Lord(1952)によってその基本的な枠組みが整備され、発展してきた
  
• ある受験者がある項目に正答する確率を、項目反応理論と呼ばれる統計モデルで表現する数理手法
  
• 受験者が受けた試験問題の難易度や、受験者集団間の能力分布に左右されない公平な評価が可能になる
  
• IRTはテストだけでなく、測定の性能評価や効率化等を目的として、心理学研究における心理尺度の作成・改良のためにも活用されている
  
• 測定対象者ごとに一次元の尺度を仮定し、その潜在的な尺度上での「潜在特性値」を推定
  
• 「潜在特性値」とは被験者の能力θのこと
  
• 同時に、項目に対していくつかの種類の項目パラメーターを推定

項目パラメータ	記号	説明
識別力（Discrimination）	a	潜在特性値θに対する反応の鋭さ（ICCの傾き）
困難度（Difficulty）	b	項目に正答するために必要な能力水準（ICCの中央）
当て推量（Guessing）	c	能力が低くても偶然正答する確率（3PLモデル）

項目特性曲線 (item characteristice curve: ICC)

• ICCは、受験者の能力レベル \(θ\) に対して正答確率 \(P(θ)\) がどのように変化するかを示す
  
• 横軸・・・潜在特性値 \(θ\)（仮定された受験者の「能力」）
  
• 縦軸・・・正解する確率
  
• 受験者の正誤データから、問題（項目）ひとつひとつについて項目反応曲線を推定
  →　項目の困難度によらない受験者の能力値を推定できる

○問題の難易度が同じなら・・・
・受験者の能力が低いほど、正解の確率は低い
・受験者の能力が高いど、正解の確率は高い

• この関係を「ロジスティック回帰分析」で推定する

• ICCを使うと、以下の2つの指標が明確になる

困難度（Difficulty Parameter)

→ ICCの曲線が横軸上のどの位置で50%の正答率を持つかを見ることで、その問題の難しさを判断できる

識別力（Discrimination Parameter)

→ 曲線の傾きが大きいほど、能力の低い受験者と高い受験者をうまく区別できる項目であることがわかる

• 5つの項目（＝問題）に関する下の項目特性曲線について考えてみる

• 問1（黒色）は能力が低い受験者でも正解率が高い、比較的易しい問題.
  
• 問3（緑色）は受験者の能力がある程度高くないと、正解できない比較的難しい問題
  
• 問題を難しい順から易しい順位並びかえると、3 → 2 → 4 → 5 → 1 となる
  
• 曲線の傾きが最も大きい問題は 3
  →　能力の低い受験者と高い受験者をうまく区別できる問題は 3

項目反応理論の特徴
・異なる問題から構成されるテスト結果を互いに比較できる
・異なる集団で得られたテスト結果を互いに比較できる

項目反応理論の利点

1. 個別的な精度評価ができる

• 従来の精度評価・・・「このテストには±X点の誤差がある」（＝全体的な評価）
  
• IRTの精度評価・・・「高能力群では±Y点の誤差、低能力群では±Z点の誤差がある」（＝個別的な精度評価）

2. テストの測定精度の情報を、受験者の能力別に評価できる

• 真に有益な問題を合理的に取捨選択できる
  
• 問題の精度を担保しつつ、テストの短縮版が作成できる
  
• テストの難易度や得点分布を事前にコントロールできる
  
• 受験者ごとに異なる問題を解いても、得点の信頼性が保証される
  
• 受験者の能力・回答状況に応じた問題の出題が可能
  →　コンピュータ適応型テスト (Computer-adaptive Testing: CAT) ができる

1.2 具体的な分析方法

◎困難度と識別力の推定

• 問題と回答者のマトリックスに正解=1、誤答=0のパターンを作る
  

• そのパターンに最も近くなるロジスティック曲線を問題の数だけ当てはめる
  

• その際、確率的に最もありそうな基準（=尤度（ゆうど））を使う
  →　尤度（ゆうど）に関しては後で解説

• 受験者の能力と、問題の難易度も推定可能
  →　良問と悪問題が区別できる

◎「等化」

• 異なるテスト間でスコアや尺度を共通化する（＝同じ「ものさし」にする）こと
• 出題した項目の困難度や識別力を根拠に、受験者の潜在特性値（＝能力θ）を推定
  →　受験者の能力θは原点と単位を任意に設定可能
  →　基準となる尺度を定義し、それに他の尺度を乗せる（＝等化）
  →　異なるテスト間で共通の意味をもつスコアを算出できる
  →　テストの内容が異なっても同じ土俵で能力が比較可能.

等化の実例：

• 2024年版のテストと2025年版のテストで、受験者のスコアを同じ尺度で比較できるようにする
  →　そのためには、共通項目（Anchor Items）などを使ってスケールを合わせる作業が必要

◎項目バンク (item bank) を作る

• IRTによって推定された項目パラメーターを、項目内容と共に記録
  →　後日、再出題し、受験者の学力レベルに応じた項目群を使ことが可能
  
• この項目群のデータバンクのことを項目バンクと呼ぶ
  
• 項目パラメーターからテスト情報関数を求める
  →　実施するテストがどの程度の学力レベルの受験者向けなのかがわかる
  →　受験者集団に依存しない評価指数を使った項目単位での検討が可能になる

◎Adaptive IRT Test を使う

→　受験者の解答結果しだいで出題問題を変える
→　受験者の能力を推定する上で最も適切な問題を出題できる
→　少ない問題・少ない時間で、受験者の能力を推定できる

◎テスト項目が適切かどうかを統計的に評価する

○主な方法：
1. テスト得点との相関分析
2. 注意係数の算出
3. 項目反応理論の適用

• 受験者を成績に基づいて、上位群と下位群に分ける
  
• 各選択肢の選択率を計算
  
• それぞれの選択肢が、適切に上位群と下位群を識別できるかどうかチェック
  →　必要なら選択肢を修正する
  
• 相関係数と因子分析を用いてテストの内的一貫性を評価する
  
• 項目反応理論を使って、識別力の低い項目を特定する

2. 項目反応理論を使う理由

• 古典的テスト理論には2つの大きな問題があるため

古典的テスト理論 (classical test theory) が直面する2つの問題 ・標本依存性 (sample dependence) の問題
・項目依存性 (item dependence) の問題

2.1 標本依存性 (sample dependence) の問題

• A 学校 の X さんの偏差値が50
  
• B 学校 の Y さんの偏差値が60
  
• 偏差値の高い Y さんの方が学力が高いといえるか？

Source: https://www.manabinoba.com/edu_watch/021771.html

• 必ずしもそうとはいえない

その理由:

・受験者集団の能力が異なるから

• もし、A学校とB学校のレベルが同一なら → 偏差値60のYさんの学力が高い
  
• しかし、A学校の方がB学校より学力が高ければ
  →　偏差値60のYさんより、偏差値50のXさんの方が学力が高い可能性がある

→　テストの困難度の評価が、そのテストを受けたサンプル（集団）のレベルに依存する
・受験者集団のレベルが高い　→　個々の受験者のテスト得点が高い　→　集団全体の平均点が高い
・受験者集団のレベルが低い　→　個々の受験者のテスト得点が低い　→　集団全体の平均点が低い

• このことをテスト得点の標本依存性という
  →　異なる集団を比較する際には注意が必要

解決策

• A校とB校を比較するために、IRTモデルでそれぞれの項目パラメーターを推定
  →　共通項目（または共通受験者）を使ってスケールを等化
  →　受験者の能力（θ）を同一スケールで比較できる

しかし、通常は・・・

• AとBという異なる2つの学校のテストなので、共通項目や共通受験者はいない
  →　等化は理論上不可能

教訓：

• 将来的に比較することがわかっているなら、最初からテスト間でアンカー項目（anchor items）を仕込んでおく

2.2 項目依存性 (item dependence) の問題

• A中学校で去年実施したテストの平均点が50点
  
• A中学校で今年実施したテストの平均点が70点
  
• この場合、A中学校の生徒の学力が伸びたとはいえるか

Source: https://www.manabinoba.com/edu_watch/021771.html

• 必ずしもそうとはいえない

その理由：

・問題の困難度（難しさ）が異なるから

• もし、去年と今年の問題が同一なら → 去年より20点学力が伸びた
  

• しかし、今年より去年の問題の方が難しいなら
  →　今年のテストの平均点より、去年のテストの平均点は低い
  →　平均値が低い去年の生徒の方が学力が高い可能性がある

• このことをテスト得点の項目依存性という
  →　異なるテストを比較することができない

• 受験者のテスト得点は、テスト個々の問題（＝項目）の困難度によっても影響を受ける

解決策

等化する

• テストに含まれる問題（= 項目）の難しさ(= 困難度）と受験者の能力を別々に推定し、同じものさしの上で評価する

ステップ1: 各年のテストにIRTモデルを当てはめ、項目パラメーターを推定

例：2PLモデルでそれぞれの項目に対して識別力a、困難度bを推定

ステップ2: 共通項目（アンカー項目）を使って尺度を「等化」する

• 去年と今年のテストに共通の問題（共通項目）を少しでも入れておく
  
• それにより、スケールを合わせるための変換係数（AとB）を推定する
  （主な方法：Stocking-Lord法, Haebara法など）

ステップ3: 能力（θ）の平均を比較

• 等化されたスケール上で、去年と今年の生徒の能力分布（θ）を比較する θの平均や分布に有意な差があれば「学力が伸びた」と言える

まとめ

テストの素点を偏差値に換算したとしても、次のような場合、受験者の能力を正しく比較できない：
(1) 学校ごとの受験者集団の能力が異なる
(2) 異なる試験時期のため問題の困難度（難しさ）が異なる

2.3 困難度と受験者の能力を区別できない問題

• 従来のテスト理論だと、A学校で実施したテストの平均点が70点だった時
  
• 従来のテスト理論だと、なぜ平均点が70点だったのかその理由がわからない
  ・生徒の学力が高かったためなのか？
  ・問題が易しすぎたからなのか？

• しかし、項目反応理論を使うと、平均点が70点だった理由の手がかりがつかめる
  ・生徒の学力平均＝2.2
  ・問題の難しさの平均＝0.7

理論別スコアの表示方法と解釈

古典的テスト理論	項目反応理論
素点	潜在特性値 \(θ\)（シータ）= 受験者の能力
偏差値	項目特性（問題の困難度・識別力）
項目特性と受験者の能力が交絡	項目特性と受験者の能力を別々に表現できる
→　困難度と受験者の能力を区別できない

• 潜在特性値 \(θ\)は、受験者集団の能力分布に依存しないスコア
  
• 項目特性とは項目の困難度や識別力のこと
  
• 問題の困難度や識別力である「項目特性」を根拠に、潜在特性値 \(θ\)（＝受験者の能力）を推定する

3. 項目反応理論 (IRT) が満たすべき仮定

• IRTに基づく分析を実行するためには3つの仮定を満たす必要がある

仮定	内容
1. 局所独立性	項目同士に余計な関連性がないという仮定
2. 正答確率の単調増加性	問題の難易度が適切であるという
3. データの適合度	項目反応モデルにデータが適合しているという仮定

3.1 局所独立性

• IRT（項目反応理論）における局所独立性（local independence）とは次の仮定

「受験者の能力値θが一定であれば、異なる項目間の応答は互いに独立している」

• 例えば、学力θが同じ受験者2人が、あるテストの問題Q1とQ2に答えるとする

局所独立性が成立している場合：

• Q1に正解したかどうかはQ2に正解したかどうかには影響しない
  
• つまり、項目の正答・誤答が学力θで説明できる限り、項目同士に余計な関連性がない

局所独立性が破られている場合：

• Q1に正解した人はQ2にも正解しやすい
  
• θ以外の因子による共通性（たとえば、似た問題文や同じ単元の知識を要求）が影響している状態

確率と尤度（ゆうど）の違い

確率	これから起きることの可能性の大きさ
尤度	既に起きたことに対して、その背後にある可能性の大きさ

確率 (Probability)

• 中が見えない袋の中に赤玉が3個と白玉が2個、合わせて5個入っている
  
• この袋から1個玉を取り出し、玉の色を確かめて袋に戻す
  
• この作業を3回繰り返す

結果：

• 1回目・・・赤
  
• 2回目・・・白
  
• 3回目・・・赤

問題：

• 結果が「赤、白、赤」になる確率は？
  
• 「積の公式」を使って計算できる

\[\frac{3}{5} × \frac{2}{5} × \frac{3}{5} = \frac{18}{125}\]

• しかし「積の公式」を使うためには
  →　「毎回、玉を取り出すことは互いに独立していて、互いに影響しあわない」という「局所独立の仮定」が必要

ポイント ・「局所独立の仮定」はIRTを使う際の大前提
・この仮定が満たされなければ、IRTで得点を算出すること自体が無意味になる

局所独立の仮定が満たされない事例：

問題1

• Choose the correct form of the verb:
  She ___ to the store every morning.
  A. go
  B. goes
  C. going
  D. gone

問題2

• Fill in the blank with the correct form:
  He ___ his homework before dinner every day
  A. do
  B. does
  C. doing
  D. done

• 問題1と問題2はともに、三人称単数の現在形の動詞の形（主語一致）を問うており、同一の文法知識に依存している
  →　問題1で正答した受験者は、問題2でも正答 (B) する可能性が高い
  →　これは単に能力θによる説明ではなく、2つの項目間の内容的な関連性（共通のスキルへの依存）によるもの
  →　ここでは、項目間に条件付き依存（conditional dependence）が生じており、局所独立の仮定が破られている

尤度 (likelyfood)

• 中が見えない袋の中に赤玉と白玉が合わせて5個入っている
  
• この袋から1個玉を取り出し、玉の色を確かめて袋に戻す
  
• この作業を3回繰り返した

結果：

• 結果は、1回目は赤、2回目は白、3回目は赤

問題：

このような結果が得られるためには、もともと袋の中に赤玉と白玉、それぞれ何個ずつ入っていた可能性が最も高いか？

• これから起こることを予測する確率の場合と異なり、玉は既に取り出されている
  
• 取り出された玉の結果（＝赤、白、赤）から、中が見えない袋の中の赤玉と白玉の個数を推定したい
  
• 既に起きたことに対して、その背後にある可能性の大きさを推定するのが尤度
  
• 赤玉と白玉の個数はそれぞれ何個が妥当なのか？
  
• それぞれの玉の個数の場合ごとの尤度を計算してみる

玉の個数	尤度
赤1個、白4個の場合	\(\frac{1}{5}×\frac{4}{5}×\frac{1}{5}= \frac{4}{125}\)
赤2個、白3個の場合	\(\frac{2}{5}×\frac{3}{5}×\frac{2}{5}= \frac{12}{125}\)
赤3個、白2個の場合	\(\frac{3}{5}×\frac{2}{5}×\frac{3}{5}= \frac{18}{125}\)
赤4個、白1個の場合	\(\frac{4}{5}×\frac{1}{5}×\frac{4}{5}= \frac{16}{125}\)

• 取り出された玉の色が「赤、白、赤」という結果を踏まえると
  →　もっとも（最も）もっとも（尤も）らしいのは「赤3個、白2個」の場合

ポイント ・IRT分析では最尤推定法(MLE)という推定法を採用している
・MLE: Maximum Likelihood Estimation

・例えば、ある生徒が「項目1に正答、項目2に誤答，項目3に正答」だった場合
→　袋の事例では「1回目が赤色、2回目が白色、3回目が赤色」
・試験結果はわかっている（＝袋から引いた玉の色はわかっている）
・この時、この生徒の学力θを推定する（＝玉が入っていた袋の中にある赤と白の玉の色を推定する）
・袋の中にある玉の色は見えない
・生徒の学力θも見えない
・IRTではこのように生徒の学力θを推定する

IRTの最尤推定：玉の例にたとえると
・観測されたデータ：「赤・白・赤」
・仮定されたパラメータ：袋の中の赤・白の組み合わせ（例：赤1白4, 赤2白3, 赤3白2, 赤4白1）
・それぞれの仮説（パラメータ）で「その観測が起きる確率（尤度）」を計算
👉 最も高い尤度をもたらしたパラメータ（玉の組み合わせ）を採用

・つまり：
あるパラメータの候補セットの中で、観測されたデータを最もよく説明できるものを選ぶ

3.2 正答確率の単調増加性

• 正答確率の単調増加性 (monotonicity) とは
  
• 受験者の能力（θ）が高くなると、その項目に正答する確率も高くなること

正答確率の単調増加性 (monotonicity) が重要な理由：

• IRTモデルの基本前提（θが高いほど正答確率も高い）を破ると、能力推定の精度が低下する
  
• テストの信頼性や妥当性が損なわれ、公正な評価ができなくなる可能性あり
  
• 誤って「良い問題」と思って使い続けると、能力の高い受験者を不当に低評価する危険性あり

3.3 データの適合度

• IRTにおけるデータの適合度（model fit）とは
  
• 「推定されたモデルが観測データをどれくらいうまく説明しているか」を判断するための重要な指標

適合度を確認する主な目的

1. モデル（1PL, 2PL, 3PLなど）の選択
   
2. 不適切な項目の発見
   
3. モデルの信頼性・予測精度の検証

IRTの適合度：3つのレベル

適合度のレベル	概要	主な方法
全体モデル	モデル全体がデータに合っているか	AIC, BIC, M2, RMSEA
項目ごと	各項目がモデルと矛盾していないか	残差分析、S-X²検定、infit/outfit
個人ごと	受験者がモデルに従って回答しているか	person-fit統計量（l_zなど）

4. 学力の数値化とその問題点

4.1 「学力」＝「テストの得点」なのか？

\[テストの得点　≠　学力\]

• 「テストの得点が学力であり、それは絶対的なものである」という考えは間違い
  
• 人間の頭の中はブラックボックス
  →　学力は「直接」測ることはできない
  →　学力は「間接的」にしか測ることができない
  
• テストの得点には「あいまいな部分」が含まれているから
  →　例えば、あるテストで90点取ったとしても
  →　それはあくまで学力の「推定値」
  →　適切に「推定」する必要がある →　最尤推定法（IRTの推定法）

• 体重や身長は「直接」測ることができる
  →　どのような計測器でも同じ結果が得られる

4.2 「採点基準」と「採点」の違い

• 「採点基準」・・・採点を行う前に、解答を分類するための基準
  
• 「採点」・・・受験者の解答を採点基準と比較して、正答、部分的に正答、誤答に分類すること

採点基準	テスト実施者の考え方が入っても良い
採点	主観が入ってはだめ

• 採点基準にはテスト実施者の考え方が入っても良い
  →　どの選択肢を「正答」とするか、どれの部分点を与えるか、どれを「誤答」とするか等などテスト実施者が決める

• 採点では、テスト実施者の主観が入ってはいけない
  →　決められた基準に照らして行う
  →　誰が、いつ、どこで採点しても同じ採点結果にならなくてはならない
  →　採点によって得られるのが「得点」

4.3 従来のテスト得点の問題点

従来のテスト得点を計算する方法

1. 正答数得点	正答した問題の数
2. 重み付き正答数得点	個々の問題の採点結果に対する配点を合計
3. 標準化（Z値）・偏差値	同一集団における相対的な位置を数値で表せる

1. 正答数得点の問題点

• 難易度も重要度も同じ場合なら、正答数得点を使っても問題なし
  
• しかし、難易度が異なる問題が含まれている場合
  →　「難しい問題に正答」　＝　「簡単な問題に正答」・・・同じ評価ではおかしい

2. 重み付き正答数得点の問題点

• 個々の問題に対して、どのように重み付け（＝配点）するかが決定的に重要
  

• 配点の付け方によって、受験者の合計得点が変わることがあるから
  

• 個々の問題の配点を「合理的で客観的な根拠に基づいて」配点配分するのは困難
  

• 問題を難しい順（あるいは簡単な順）に並べるのは容易ではない

• 合理的な配点の決め方はない
  

• 配点が妥当かどうかを十分に検証することもできない

• 例えば、100点満点で90点得点したとする

• これは、正答した問題に対する配点の合計
  

• 採点が基準どおりに行われ、得点の合計も正確に行われたとしても
  →　個々の問題の配点は「合理的で客観的な根拠に基づいて」決められていない
  →　この問題の配点には「おそらく90点くらいでいいのではないか」という「あいまいさ」の要素が混じっている

• もし、この「あいまいさ」の程度が客観的にわかれば
  →　それを踏まえて、テストの得点を解釈すれば良い

3. 標準化（Z値）・偏差値の問題点

• 偏差値は、平均値を基準にして、標準偏差を単位として、どのくらい上か下かを表すもの
  
• 2つの集団の平均値が同じなら　→　偏差値を使って異なる集団の生徒の成績を比較できる
  
• しかし、異なる集団であれば、平均値は異なる
  →　異なる集団同士の偏差値は比較できない
• 標準化（Z値）と偏差値の詳細に関しては 「11. z 検定と t 検定」 の「2.2 基準化 (Standardization)」「 2.3 標準正規分布表の読み方」「2.4 偏差値」を参照

従来のテスト得点の問題点

1. 問題が異なるテストの場合、正答数得点や重み付き正答数得点を比較できない
2. 正答数得点では、出題された問題の難易度や重要度が得点に反映されない
3. 重み付け正答数得点のばあい、合理的で客観的な配点の決め方が不明確
4. 異なる集団から得られた偏差値は比較できない

IRTの貢献

従来のテスト得点の問題点に関して

1. 問題が異なるテストの場合、正答数得点や重み付き正答数得点を比較できない
   →　問題が異なるテストでも、テストの点数を相互に比較できる
   （ただし「局所独立の仮定」と「テストの1次元性条件」を満たす必要あり）

2. 正答数得点では、出題された問題の難易度や重要度が得点に反映されない
   →　問題の難易度を合理的な方法で分析し数値化できる
   （問題の「難易度」がわかる）
   →　学力の違いによって、正誤にどれだけの差があるかわかる
   （問題の「重要度」がわかる）

3. 重み付け正答数得点のばあい、合理的で客観的な配点の決め方が不明確
   →　IRT分析では、事前でも事後でも配点を決める必要はない
   →　IRT分析では配点に代わるパラメータを使う

4. 異なる集団から得られた偏差値は比較できない
   →　異なる集団から得られた結果も比較できる

5. IRTによる学力推定方法 I

項目反応理論の特徴
・異なる問題から構成されるテスト結果を互いに比較できる
・異なる集団で得られたテスト結果を互いに比較できる

• ここでは、なぜ IRT を使うとこの二つの事ができるのか、その理由を解説する

5.1 IRTで用意する「ものさし」

• 従来の学力測定と異なり、IRT では学力を測定する道具として目盛りのついた「ものさし」を用意する

学力を測定するものさし・・・学力θ

• IRT 測定する学力・・・「学力θ」＝「潜在特性値θ」（θはシータと読む）

1. テスト作成者は配点を決める必要はない
   
2. テストの正答数の合計点を数える必要はない
   
3. 偏差値を求める計算式\(\frac{得点ー平均値}{標準偏差}× (10+50)\)は必要はない

• 学力θの求め方

\[受験者の正誤パターンから、最も可能性の高い「学力θ」を推定する\]

IRT で使うデータの構造

\(u_{ij}\) の意味 　　

「受験者 \(i\) の \(j\) 番目にある項目の正誤を示す」

• テスト理論の出発点は「正誤データ」（1は正解、0は誤答）
• 受験者が 3 人おり、1番目がA、2番目がB、3番目がC　→　受験者の順番を \(i\) で表す
  
• 項目が 3 つあり、1番目がQ1、2番目がQ2、3番目がQ3 →　項目の順番を\(j\)で表す

• \(u_{ij}\) は「i番目の受験者」の「j番目の問題」の「正誤結果」を示す

• 例えば、\(u_{12}\) は 「1番目の受験者」「2番目の問題」の正誤結果 1 を示す
  →　つまり、正誤データ \(u_{ij}\) の正誤結果は 1

ガットマンスケール 　　

• IRT における「学力θ」の推定・・・視力検査と似ている
  
• 下の左図は視力検査に使う「ランドルト環」と呼ばれる表
  
• 参加者に様々な大きさの「C」の形をした刺激（ランドルト環）を提示
  →　「C」の切れ目の方向（上下左右）を回答させる
  →　「何個正答できたか」ではなく「どの大きさまで正しく答えられたか」が重要
  →　どんなにたくさん大きな「C」に正答しても視力がいいとはいえない
  →　どれくらい小さい「C」に正答できたか　→　視力いいと判断される（＝推定される）

同様の事が IRT でも当てはまる

→　どんなにやさしい問題に正答できても「学力θ」の値は高いとはいえない
→　どれくらい難しい問題にに正答できたか　→　学力θが高いと判断される（＝推定される）

• この検査データを表にまとめたものが上の左図
  
• 「ガットマンスケール」と呼ばれている
  
• 目の検査を受けたのはA, B, C, …., L までの12人
  
• 「C」の大きさの「見やすさ」は最大の 0.1（最上位）から最小の 1.5（最下位）まで変化する
  →　この「見やすさ」が刺激
  
• A さんは全ての項目で正解 (= 1) => 視力が良い
  
• B さんは「見やすさ = 1.5」以外は全ての項目で正答 (= 1)
  
• L さんは全ての項目で不正答 (= 0) => 視力が悪い
  
• 「ガットマンスケール」では、物理的な量の大小（＝刺激の大きさ）を心理量（＝視力）に置き換えるための尺度を構成している
  
• 各刺激に対する正答率と参加者の「真の視力」の間にどのようの対応関係があるかを適切に記述
  →　刺激が参加者の視力をどの程度識別できるかの指標（＝識別力）を与えることができる
  
• IRTでは、潜在特性値 \(θ\)（ここでは視力）によって、正答する確率を記述する
  
• 項目の正誤データを 2 値データ (0 or 1) とみなし、因子分析により一因子を抽出する操作を行う
  →　受験者ごとに算出されるのが潜在特性値 \(θ\)（ここでは「視力」）
  
• 潜在特性値は原点と単位に不定性がある
  →　平均 = 0、標準偏差 = 1 とすることで、標準化得点（z値）のように扱うことができる
  →　分析結果の解釈が容易

視力検査と IRT の類似点

• 学力テストの場合・・・項目の難しさを決めるもの＝正答率
  

• しかし、正答率を使うと、同じ項目でもテストを受験する集団のレベルが異なると
  →　正答率が変わる
  ・レベルが高い集団なら　→　正答率は上がる（＝その問題はやさしいとみなされる）
  ・レベルが低い集団なら　→　正答率は下がる（＝その問題は難しいとみなされる）

• しかし、視力検査ではガットマンスケールを使って「輪の大きさ」に対応する視力をあらかじめ決めている

→　視力レベルの高い集団でも低い集団でも同様に検査できる

分析方法	項目の困難度を測る手がかり
・視力検査	輪の大きさ（ガットマンスケール）
・IRT	項目特性

5.2 項目特性

• テストを受験する集団のレベルと関係なく、項目の困難度を決める方法・・・項目特性

項目特性とは

学力θの違いに応じた、その項目に正答できる確率

項目特性曲線（Item Characteristic Curve，ICC）

• この項目はどのレベルの能力の人にとって難しいのか？
  
• どれくらい鋭く正解率が変わるのか？（識別力）
  ・ある項目（= 問題）に対して、受験者の能力 \(\theta\) に応じた正答確率を表す曲線
  ・潜在特性値 \(\theta\) の値毎に正答確率を計算し、プロットしたもの

・横軸・・・学力θ（潜在特性値）
・縦軸・・・正答確率（0 〜 1）

• 受験者の能力θの高低に応じて、その項目に正答できる確率がどう変化するかを可視化したもの
  ・学力θが低い受験者から高い受験者になるにつれ　→　正答できる可能性は徐々に高まる

曲線の傾きに注目すると：

・学力θが低い受験者　→　正答確率が緩やかに上昇している
・学力θが中程度の受験者　→　正答確率が急に上昇している
→　傾きが最大　→　学力θが1単位上昇したときに正答する確率（＝識別力）が最も大きい
・学力θが高い受験者　→　正答確率が緩やかに上昇している

5.3 IRTモデル

5.3.1 項目特性とは

項目特性は、テストを実施した結果を IRT 分析することで得られる

• 分析によって得られた項目特性は、個々の項目固有のもの
  →　項目ごとに項目特性曲線の形は異なる

• IRT 分析では様々なモデルが使われるが、ここでは最も良く使われる 2 パラメータ・ロジスティック・モデルを紹介する
  

• 2 パラメータ・ロジスティック・モデルの項目特性曲線の形は、項目の「困難度」と「識別力」によって決まる
  

• 2 つのパラメータによって項目特性曲線の形が決まる
  →　2 パラメータ・ロジスティック・モデルと呼ばれる
  

• 「困難度」と「識別力」= 項目パラメータ

表記	詳細
\(P(\theta)\)	能力θを持つ受験者が、ある項目に正答する確率
\(\theta\)	受験者の能力で、平均0・標準偏差1の正規分布に従うと仮定
\(a\)	識別力（discrimination）パラメータ
\(b\)	困難度（difficulty）パラメータ＝位置パラメータ
\(j\)	項目の番号

2 パラメタ・ロジスティックモデル (2PLM)

\[P_j(\theta) = \frac{1}{1 + exp[-1.7a_j(\theta-b_j)]}\]

潜在特性値 \(θ\)（視力）を項目特性曲線 (ICC) を使って可視化

• 横軸・・・受験者の能力\(θ\)　　
• 縦軸・・・正答する確率 (0 〜 1)
  
• 3 つの項目の「識別力」は同じ = 1.2
  
• 3 つの項目の「困難度」は異なる: -0.5〜1.0
  
• 「困難度」が大きい程、項目特性曲線は右側に寄る
  
• 項目特性曲線が右側に寄っている = より高い学力θでないと正解できない
  →　より難しい項目

5.3.2 「困難度の違い」による項目特性曲線の変化

正答確率を 50%に固定してみる

• 識別力の値を固定し（b = 1.2）、困難度の違い (-0.5〜1.0) によって項目特性曲線がどう変わるか確認する
  
• 50%の確率で正答するところに点線を引く
  
• 50%の確率で正答するためには、難しい問題だと(b = 1.0)、大きな学力θ (1.0)が必要
  
• 50%の確率で正答するためには、簡単な問題だと(b = -1.0)、小さな学力θ (−1.0) でもよい

• 困難度は正答確率が50%となる学力θ
  
• ある項目について、正答できる人と正答できない人の割合が半々になる学力θが、その項目の難しさを表している

5.3.3 適切な困難力 b の大きさ

推奨される困難度 b の範囲	−3 〜 3
最も推定が安定する b の範囲	−2 〜 2

適切な困難力 b の大きさ

−3 〜 3

（出典：芝祐順編『項目反応理論』p.34）

5.3.4 「識別力の違い」による項目特性曲線の変化

• 困難度を固定して (a = 0)、識別力の違い (0.5〜1.5) によって項目特性曲線がどう変わるか確認する
  
• 3つの項目の困難度が同じ = 正答確率が50%となる学力θの値が同じ
  →　同じ能力θで正答になる
  →　学力θ = 0、正答確率 = 0.5 (=50%) で1点で交わる
  
• 1点で交わる付近を見ると、項目特性曲線の立ち上がり度合い（＝傾き）が異なる
  
• 傾きが大きい　→　学力θが正答確率に与える影響がより大きい（＝正答確率の違いがより大きい）

• 項目1における学力θが−4の時の正答確率・・・0.416
  
• 項目1における学力θが4の時の正答確率・・・0.584
  →　正答確率の差・・・0.584-0.416 = 0.168

• 項目3における学力θが−4の時の正答確率・・・0.265
  
• 項目3における学力θが4の時の正答確率・・・0.735
  →　正答確率の差・・・0.735-0.265 = 0.47

• 学力θが困難度が0付近のばあい、同じだけ学力θに違いがあると、識別力が大きい項目（＝項目3）ほど、より大きな正答確率の違いとなる
  →　識別力の大きな項目（＝項目3）ほど、正答できなさそうな人と正答できそうな人を、より明確に見極めることができる

識別力のポイント
・識別力は、学力θの差によって正答者と誤答者をどのくらい敏感にみわけられるか（＝識別できる）を判断する基準

・ただし、学力θが困難度 = 0 付近のばあいに限られる

5.3.5 適切な識別力の大きさとは

• 下の図は、識別力が 0, -0.5, 10 という3つの場合の項目特性曲線を示している

識別力が 0 の場合

• 項目2（識別力 = 0） ・・・項目特性曲線は水平
  →　学力が高くても低くても正答確率は同じ
  →　テストをする意味がない
  →　テストに出題すべきでない

識別力がマイナスの場合

• 項目1（識別力 = -0.5） ・・・項目特性曲線は右下がり
  →　学力が低いと正答確率が高く、学力が高いと正答確率が低い
  →　テストをする意味がない
  →　テストに出題すべきでない

識別力が大きすぎる場合

• 項目3（識別力 = 10） ・・・項目特性曲線の傾きが0付近で爆増
  →　この項目が「不適切」だとは断言できない
  →　ただ他の問題と比較して「異質」であることは確か
  →　問題全体からみて、その問題が適切かどうか検討すべき

適切な識別力 a の大きさ

0.3 〜 2.0

（出典：芝祐順編『項目反応理論』p.34）

5.3.6 IRTで使う「ものさし」

• 身長や体重を「測る」ことと学力を「推定」することは異なる
  
• 身長・・・身長を測る「ものさし」があるから、推定する必要はない
  
• 原点（= 0）と単位 (cm) がついた身長計を使って「直接」計測できる

• 学力は「直接」計測でできない
  
• 測定対象である「学力」も「ものさし」もどちらも「仮定されたもの」
  →　学力の中身をはっきりさせない（できない）まま
  →「仮定したものさし」を使って「仮定した学力θ」を推定する
  →　そのためには、測定のための「ものさし（＝尺度）」が必要
  →　「ものさし」には「原点」と「単位」が必要

IRTで学力を推定するための方法

・学力が平均値 0、標準偏差が 1 で分布していると仮定
・その学力を、原点が0で、−3 〜 3 まで目盛りのついた「ものさし」で測定する

6. IRTによる学力推定方法 II

• IRTによる学力θの推定法・・・受験者の正誤パターンから、最も可能性の高い学力θを推定する　
  
• ここでは2パラメータ・ロジスティック・モデルを使って分析する

データの準備

• ltmパッケージの中に入っているデータを使う
  • The Law School Admission Testへの解答結果を採点

• 受験者数: 1000人
  

• 項目数：Section IVに含まれる５項目
  

• 正答なら1、誤答なら０

変数名	詳細
ID	受験者のID
Item1	１番目の項目への解答結果 (0 or 1)
Item2	２番目の項目への解答結果 (0 or 1)
Item3	３番目の項目への解答結果 (0 or 1)
Item4	４番目の項目への解答結果 (0 or 1)
Item5	５番目の項目への解答結果 (0 or 1)
SS	Item1-5の合計点
class	素点に基づく受験者のクラス分け

•class: 1〜5で表され、値が高くなるほど素点の高いクラス
- このデータをIRTに基づき分析し、項目やテストの特性を評価する - 分析で使うパッケージを読み込む

library(ltm)

• データを読み込む

data(LSAT)

• データフレーム LSAT が含む変数名を確認する

names(LSAT)

[1] "Item 1" "Item 2" "Item 3" "Item 4" "Item 5"

• Item 1 を item1 に変更する（変数名から半角スペースを削除）

LSAT <- LSAT |> 
  rename("item1" = "Item 1",
    "item2" = "Item 2",
    "item3" = "Item 3",
    "item4" = "Item 4",
    "item5" = "Item 5")

• item1 から item5 までの合計点を表す変数 total を作る

LSAT <- LSAT |> 
  dplyr::mutate(total = rowSums(dplyr::across(item1:item5), 
    na.rm = TRUE)) # 欠損値（NA）があっても無視して合計するよう指定

DT::datatable(LSAT)

6.0 irtoys パッケージを使った分析

• ここでは次の手順で分析を進める
  
• 主として irtoysパッケージを使う

	使う関数	内容
1. 正答率の計算	colMeans()	データの適合性を検討
2. I-T相関の計算	cor()	データの適合性を検討
3. 1 次元性の計算	fa.parellel()	データの適合性を検討（psychパッケージ）
4. 項目パラメーターの推定	est()	「困難度」「識別力」の推定
5. 項目特性曲線 (ICC)	irf() & plot()	結果の解釈
6. 潜在特性値の推定	ltm() & plot()	能力\(\theta\)の推定
7. テスト情報曲線 (TIC)	tif() & plot()	結果の解釈
8. 局所独立性の検討	irf() & cor()	推定値の妥当性を検討
9. 項目適合度の検討	itf()	推定値の妥当性を検討
10. テスト特性曲線 (TCC)	trf() & plot()	結果の解釈
11. 潜在特性値の推定	mlebme()

6.1 正答率の計算: colMeans()

• 正答率の計算
  
• colMeans()関数を使って正答率 (Correct Response Rate: crr)を計算

crr <- colMeans(x = LSAT[, 1:5],
  na.rm = TRUE)

crr

item1 item2 item3 item4 item5 
0.924 0.709 0.553 0.763 0.870 

• ここで得られた結果 crr は「名前付きの数値ベクトル」: named numeric vector
  →　使い勝手が悪いので、このベクトルをデータフレームに変換する

df_crr <- data.frame(      # データフレーム名を指定（ここでは df_crr と指定）
  item = names(crr),       # 変数名を指定（ここでは item と指定）
  seikai = as.numeric(crr) # 変数名を指定（ここでは seikai と指定）
)

• データフレームを確認

df_crr

   item seikai
1 item1  0.924
2 item2  0.709
3 item3  0.553
4 item4  0.763
5 item5  0.870

• 正答率が低い順位並べ変えて表示させてみる
  
• seikai の大きい順に因子の順序を指定

df_crr$item <- factor(df_crr$item, 
  levels = df_crr$item[order(df_crr$seikai)])

ggplot(df_crr, aes(x = seikai, y = item)) +
  geom_bar(stat = "identity", fill = "skyblue") +
  geom_text(aes(label = round(seikai, 2)),  # 小数第2位で丸める
            hjust = 1.2, size = 6) +        # 棒の内側に表示
  labs(
    title = "各項目の正答率",
    x = "項目",
    y = "正答率"
  ) +
  theme_minimal() +
  theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策  

• item1の正答率が最も高く (92%)、item3が最も正答率が低い(55%)ことがよくわかる

正答率の計算のポイント ・極端に正答率の高い/低い項目があるかどうか
- 極端に高い/低い項目がある場合　→　問題あり
- 極端に高い/低い項目がない場合　→　問題なし

→　ここでは極端に高い/低い項目がない　→　問題なし
→　次の分析に移る

6.2 I-T相関の計算: cor()

• cor()関数を使って、素点 (item1 〜 item5) と合計点 total との相関を計算

it <- cor(x = LSAT[, 1:5],
  y = LSAT[, 6],
  use = "pairwise.complete.obs")

it

           [,1]
item1 0.3620104
item2 0.5667721
item3 0.6184398
item4 0.5344183
item5 0.4353664

• ここで得られた結果 it は「「行名付きの1列行列（matrix）」」

→　使い勝手が悪いので、この matrix をデータフレームに変換して、行名を項目名の列として追加する

# 行列をデータフレームに変換
df_it <- as.data.frame(it)

# 行名を項目名として列に追加
df_it$item <- rownames(df_it)

# 列名をわかりやすく変更（オプション）
colnames(df_it) <- c("correlation", "item")

DT::datatable(df_it)

• 相関係数が低い順位並べ変えて表示させてみる
  
• correlation の値順に因子の順序を指定

df_it$item <- factor(df_it$item, 
  levels = df_it$item[order(df_it$correlation)])

ggplot(df_it, aes(x = item, y = correlation)) +
  geom_bar(stat = "identity", fill = "orange") +
  geom_text(aes(label = round(correlation, 3)), 
    vjust = -0.5, size = 4) +
  ylim(0, 0.7) +
  labs(
    title = "項目－合計相関（item-total correlation）",
    x = "項目",
    y = "相関係数"
  ) +
  theme_minimal() +
  theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策  

• 素点 (item1 〜 item5) と各項目得点 (total) との相関は 0.36〜0.61の間

I-T相関の計算のポイント ・各項目への反応 (item1〜item5) と合計点 (ss) との間にI-T 相関が認められるかどうか

IT相関の値	評価	項目の扱い
〜 0.2	極めて低い（要注意）	除外を検討する
0.2〜0.3	やや低い	内容によって再検討
0.3〜0.4	妥当なレベル	保留・文脈による判断
0.4以上	良好（望ましい）	採用して問題なし

→　ここでは全て 0.2 以上の相関が認められる　→　問題なし
→　項目を除外せず、次の分析に移る

6.3 一次元性の検討: fa.parellel()

• 因子分析で利用される方法を用いて検討することが多い
  

1. スクリープロット
   
2. 平行分析（Horn, 1965）
   ⇒ Rでの実行方法については質問紙データの解析例にて解説

一次元性の検討 ・各項目反応の背後に 1 つの潜在特性を仮定できるかどうか
- 1 つの潜在特性を仮定できない場合　→　問題あり
- 1 つの潜在特性を仮定できる場合　→　問題なし

→　ここでは・・・・・　→　問題なし
→　次の分析に移る

3つのデータの適合性（正答率、I-T相関、1次元性）をクリア

→　項目パラメーター（「識別力a」と「困難度b」）と潜在特性値（学力θ）の推定へ

6.4 項目パラメーターの推定

・ここでは 2 パラメタ・ロジスティックモデル (2PL: 一般化ロジスティックモデル)を使って分析する

2 パラメタ・ロジスティックモデルの目的 テストに出題した項目パラメーターをもとに、受験者の正誤パターンが最も生じやすい学力θを推定する

• 潜在特性値は平均が０、分散が１の正規分布（標準正規分布）に従うと仮定して推定を行うのが一般的

項目パラメータの推定法

• 学力θは受験者の正誤パターンだけを使って推定する
  
• 項目パラメータも受験者の正誤パターンから推定する

推定対象	推定に必要な情報
学力θ	推定したい受験者の正誤パターン
項目パラメータ	全ての受験者の正誤パターン

・項目パラメータは、その項目を含むテストを受験した受験生の正答・誤答情報をもとに、IRTを使って分析して得られる

• 項目パラメータ（識別力・困難度）と受験者の学力θを「同時に」推定する
  →　「同時」最尤推定法を使う

同時最尤推定法

項目パラメータ推定に関してできることとできないこと

私たちができないこと：

・「識別力が○○、困難度が△△の問題」をあらかじめ作ること
←　試験結果を使って IRT分析しないと項目パラメータを得られないから

私たちができること：

・多くの項目を作成し、それを受験生に受けてもらって IRT 分析する
→　ひとつひとつの項目の検証・検討を積み重ねる

1PLモデルと2PLモデルの違い

特徴	1PLモデル（Raschモデル）	2PLモデル（一般化ロジスティックモデル）
モデル式	\(P（正答）= \frac{1}{1+e^-(\theta-b)}\)	\(P（正答）= \frac{1}{1+e^{-a}(\theta-b)}\)
識別力 a	すべての項目で同じ（固定）	項目ごとに推定
困難度 b	項目ごとに推定	項目ごとに推定
パラメータ数	項目数（b のみ）＋1（a 固定）	項目数 × 2（a と b をそれぞれ推定）
分析対象	能力と困難度 b の関係	能力、困難度 b、識別力 a の関係（より柔軟なモデル）

• 1PLモデル（Raschモデル）では「すべての項目が等しい識別力を持つ」という強い仮定がある
  
• 2PLモデルはその仮定を緩め、実際の項目の識別力の違いを反映する 　　

→　1PLモデルでは「困難度（bパラメータ）」だけが推定される
→　2PLモデルでは「困難度（bパラメータ）」と「識別力（aパラメータ）」が推定され
→ 2PLモデルでは、項目ごとの「能力の区別のしやすさ」が明らかになる

2 パラメタ・ロジスティックモデル (2PL)

• 2PLモデルは、1PLのRaschモデルより柔軟
  →　パラメータ数が増える分だけ推定の安定性はやや下がる
  
• 2PLモデルの数式：

\[P_j(\theta) = \frac{1}{1 + exp[-1.7a_j(\theta-b_j)]}\]

表記	詳細
\(P(\theta)\)	能力θを持つ受験者が、ある項目に正答する確率
\(\theta\)	受験者の能力で、平均0・標準偏差1の正規分布に従うと仮定
\(a\)	識別力（discrimination）パラメータ
\(b\)	困難度（difficulty）パラメータ＝位置パラメータ
\(j\)	項目の番号

• ltm パッケージの est()関数で項目パラメーターを推定する
  →　ex1 として保存

ex1 <- est(resp = LSAT[, 1:5], # テストデータを指定する引数
  model = "2PL",        # 2PLMを仮定
  engine = "ltm")　# ltmパッケージを利用して項目パラメーターを推定すると指定

ex1

$est
           [,1]       [,2] [,3]
item1 0.8253717 -3.3597333    0
item2 0.7229498 -1.3696501    0
item3 0.8904752 -0.2798981    0
item4 0.6885500 -1.8659193    0
item5 0.6574511 -3.1235746    0

$se
          [,1]       [,2] [,3]
[1,] 0.2580641 0.86694584    0
[2,] 0.1867055 0.30733661    0
[3,] 0.2326171 0.09966721    0
[4,] 0.1851659 0.43412010    0
[5,] 0.2100050 0.86998187    0

$vcm
$vcm[[1]]
           [,1]      [,2]
[1,] 0.06659708 0.2202370
[2,] 0.22023698 0.7515951

$vcm[[2]]
           [,1]       [,2]
[1,] 0.03485894 0.05385658
[2,] 0.05385658 0.09445579

$vcm[[3]]
           [,1]        [,2]
[1,] 0.05411071 0.012637572
[2,] 0.01263757 0.009933553

$vcm[[4]]
           [,1]       [,2]
[1,] 0.03428641 0.07741096
[2,] 0.07741096 0.18846026

$vcm[[5]]
           [,1]      [,2]
[1,] 0.04410211 0.1799518
[2,] 0.17995180 0.7568684

6.5 項目特性曲線 (ICC)

ex1 <- est(resp = LSAT[, 1:5], # テストデータを指定する引数
  model = "2PL",        # 2PLMを仮定
  engine = "ltm")　# ltmパッケージを利用して項目パラメーターを推定すると指定

• ここでは 5 項目の「識別力a」と「困難度b」が計算できた
  
• 5 項目の特性曲線を描いてみる

P1 <- irf(ip = ex1$est) # irf()関数を使って正答確率を計算  

plot(x = P1,     # xは引数、irf関数で推定した結果を指定する
  co = NA,      # ICCの色を指定/項目毎に異なる色でICCを描く
  label = TRUE) # 各ICCに項目の番号がつく

abline(v = 0, lty = 2) # x = 0 の縦点線を引く

横軸・・・潜在特性値 \(θ\) (Ability)
縦軸・・・正答確率 (Probability of a correct response)

• ここに表示された番号は「項目名」(Q1,….Q10) でもあり列番号 (1,…,10) でもある
  →　修正せずに、そのまま使える

項目特性曲線 (ICC) でわかること ● item3 の曲線は図の中央あたりにあり、識別力（a）も高め → 優れた項目
● item1・item5は曲線が左に寄っていて、問題が簡単すぎる項目
● 曲線が急なものほど、能力の違いをよく識別できる（item3が典型）
・item3 は θ ≒ −1 あたりで急激に上昇
→ 能力値が上がるにつれて正答確率が鋭く上がる
→ 識別力が高い
→ このような項目は、平均的な受験者を的確に弁別する良い項目

結果の解釈

識別力 a の解釈：

・項目が能力をどれだけ区別できるかを示すパラメータ

適切な識別力 a の大きさ

0.3 〜 2.0

（出典：芝祐順編『項目反応理論』p.34）

• 識別力を可視化

# 必要なパッケージ
library(irt)
library(ggplot2)
library(dplyr)

# モデル推定（再掲）
ex1 <- est(resp = LSAT[, 1:5], 
           model = "2PL",        
           engine = "ltm")

# 識別力（1列目）を取り出し
disc <- ex1$est[, 1]

# データフレームに変換して並び替え（小さい順に変更！）
disc_df <- data.frame(
  Item = names(disc),
  Discrimination = disc
) %>%
  arrange(Discrimination) %>%  # ★ここを修正
  mutate(Item = factor(Item, levels = Item))  # 並び替えを反映

# グラフ描画
ggplot(disc_df, aes(x = Item, y = Discrimination)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(aes(label = round(Discrimination, 2)), vjust = -0.5, size = 4) +
  labs(title = "識別力が小さい順に並べた項目", x = "項目", y = "識別力") +
  theme_minimal() +
  theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策 

→ 識別力 a の範囲 ≈ 0.66 〜 0.89 → 問題なし

困難度 b の解釈：

適切な困難力 b の大きさ

−3 〜 3

（出典：芝祐順編『項目反応理論』p.34）

• 困難度の値順に可視化する

# 必要パッケージ
library(irt)
library(ggplot2)
library(dplyr)

# モデル推定（再掲）
ex1 <- est(resp = LSAT[, 1:5], 
           model = "2PL",       
           engine = "ltm")

# 困難度（2列目）を取り出す
difficulty <- ex1$est[, 2]

# 項目名を取得してデータフレームに
diff_df <- data.frame(
  Item = rownames(ex1$est),
  Difficulty = difficulty
) %>%
  arrange(Difficulty) %>%  # 小さい順に並べる
  mutate(Item = factor(Item, levels = Item))  # 並び順を固定

# グラフ描画（縦棒グラフ）
ggplot(diff_df, aes(x = Item, y = Difficulty)) +
  geom_bar(stat = "identity", fill = "coral") +
  geom_text(aes(label = round(Difficulty, 2)), vjust = -0.5, size = 4) +
  labs(title = "困難度が小さい順に並べた項目", x = "項目", y = "困難度") +
  theme_minimal() +
  theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策 

• item1とitem5が簡単すぎる問題（困難度 b が−3以下)
  
• item4, item2, item3は適度な難易度

→ 困難度 b の範囲 ≈ −3.36 〜 −0.28 → 簡単すぎる

標準誤差（識別力）の解釈：

標準誤差（識別力）の範囲

0.1 〜 0.4（識別力 a の標準誤差）

（出典：芝祐順編『項目反応理論』p.34）

# 必要パッケージ
library(irt)
library(ggplot2)
library(dplyr)

# モデル推定
ex1 <- est(resp = LSAT[, 1:5], 
           model = "2PL",       
           engine = "ltm")

# 識別力の標準誤差（標準偏差）を取り出す
disc_se <- ex1$se[, 1]  # 1列目が識別力の標準誤差

# 項目名を取得
item_names <- rownames(ex1$est)

# データフレームに変換して、小さい順に並べ替え
disc_se_df <- data.frame(
  Item = item_names,
  Discrimination_SE = disc_se
) %>%
  arrange(Discrimination_SE) %>%  # 小さい順に並べ替え
  mutate(Item = factor(Item, levels = Item))  # 並び順をグラフに反映

# グラフ描画（縦棒グラフ：左小 → 右大）
ggplot(disc_se_df, aes(x = Item, y = Discrimination_SE)) +
  geom_bar(stat = "identity", fill = "darkgreen") +
  geom_text(aes(label = round(Discrimination_SE, 3)), 
            vjust = -0.5, size = 4) +
  labs(title = "識別力の標準誤差（SE）が小さい順に並べた項目", 
       x = "項目", 
       y = "識別力の標準誤差") +
  theme_minimal()　+
  theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策 

• 識別力 a の標準誤差の範囲: 0.185 〜 0.258 →　全て推奨範囲内　→　問題なし

標準誤差（困難度）の解釈：

標準誤差（困難度）の範囲

0.2 〜 0.5（困難度 b の標準誤差）

（出典：芝祐順編『項目反応理論』p.34）

# 必要パッケージ
library(irt)
library(ggplot2)
library(dplyr)

# モデル推定
ex1 <- est(resp = LSAT[, 1:5], 
           model = "2PL",       
           engine = "ltm")

# 困難度の標準誤差（標準偏差）を取り出す（2列目）
diff_se <- ex1$se[, 2]

# 項目名を取得
item_names <- rownames(ex1$est)

# データフレームに変換して、小さい順に並べ替え
diff_se_df <- data.frame(
  Item = item_names,
  Difficulty_SE = diff_se
) %>%
  arrange(Difficulty_SE) %>%  # 小さい順に並べ替え
  mutate(Item = factor(Item, levels = Item))  # 並び順を固定

# グラフ描画
ggplot(diff_se_df, aes(x = Item, y = Difficulty_SE)) +
  geom_bar(stat = "identity", fill = "purple") +
  geom_text(aes(label = round(Difficulty_SE, 3)), 
            vjust = -0.5, size = 4) +
  labs(title = "困難度の標準誤差（SE）が小さい順に並べた項目", 
       x = "項目", 
       y = "困難度の標準誤差") +
  theme_minimal()　+
  theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策 

• item1とitem5の推定が不安定（どちらも se = 0.87）
• それ以外は適度な標準誤差 (0.1 〜 0.43)

分析結果のまとめと改善のヒント

分析結果のまとめ

・全体的に簡単な項目に偏っている
・item3 は 適度な難易度・高い識別力で、IRT的には非常に良い項目
・item1とitem5 は簡単すぎて識別力も低め
　→　テストの目的によっては、除外や見直しすべき

改善のヒント：

・困難度という観点から、困難度が −3 以下の item1 と item5 は削除対象
・代わりに難しい項目を追加するとバランスがよくなる
・識別力の高い（a > 1.2）項目を加えると、能力の区別精度が上がる
・b ≈ 0〜+2 の項目を加えると、高能力者の識別力も補強できる

6.6 潜在特性値（学力θ）の推定

• IRTモデルでは、観測された回答データ（正答/誤答）を使って
  →　受験者の学力θ（潜在特性値）を推定する
  
• その代表的な方法の一つが 最尤推定法（MLE: Maximum Likelihood Estimation）

最尤推定法の基本的な考え方 ・学力 θ の候補値を −3 から 3 まで 0.1 ごとに調べる
・どの θ のときに「そのパターンの回答が起こる可能性（尤度）」が最も高くなるかを探す
・その「最も可能性が高いθ」が、学力（潜在特性）の推定値

学力θを推定する確率計算

• 学力θを推定する確率計算

• ltmパッケージの中に入っているデータを使う
  • The Law School Admission Testへの解答結果を採点

• 受験者数: 1000人
  

• 項目数：Section IVに含まれる５項目
  

• 正答なら1、誤答なら０

観測された回答データ（正答/誤答）

DT::datatable(LSAT)

• theta（学力θのこと）の値が −3 から 3 までの範囲で、0.1 ごとの項目ごとの正答率を計算してみる

library(ltm)

# 2PLモデルによるIRT分析（5項目に限定）
mod <- ltm(LSAT[, 1:5] ~ z1, IRT.param = TRUE)

# 能力値 θ の範囲指定
theta_vals <- seq(-3, 3, by = 0.1)

# モデルから項目パラメーター（識別力 a、困難度 b）を抽出
coefs <- coef(mod)  # 戻り値は列1 = Dffclt (b), 列2 = Discr (a)

# 正答確率を格納するデータフレームの作成
icc_df <- data.frame(theta = theta_vals)

# 各項目に対して正答確率を計算（2PLモデルの公式）
for (i in 1:nrow(coefs)) {
  b <- coefs[i, 1]  # 困難度 b
  a <- coefs[i, 2]  # 識別力 a
  P_theta <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLのICC式
  icc_df[[paste0("Item", i)]] <- round(P_theta, 4)
}

• theta（学力θのこと）の値が −3 から 3 までの範囲で、0.1 ごとの項目ごとの正答率が計算できた

item1 から item5 までの正答確率

DT::datatable(icc_df)

• 「Show 100 entries」と指定
  

• theta（学力θのこと）の値が 0.1 ごとの項目ごとの正答率をすべて確認できる

• この結果を項目特性曲線として可視化してみる

plot(mod, type = "ICC", items = 1:5)

# 縦の点線を追加（θ = -3）
abline(v = -3, col = "red", lty = 2, lwd = 1)

• theta（学力θ） = -3 に赤い点線を引いた
  
• theta = -3 の場合、item1 の数値 0.5737
  →　黒線 (item1) は Probability = 0.57 を示している
  
• theta = -3 の場合、item3 の数値 0.0815
  →　緑線 (item3) は Probability = 0.0815 を示している

例えば、この学生の正誤パターン（正正正正誤）が起こる確率を学力θごとに計算する 　

item1	item2	item3	item4	item5
正答	正答	正答	正答	誤答

最も学力θが低い学生（θ= -3）の正誤確率

• この学生が item5 に正答し、item1 から item4 までは誤答する確率を計算
• この学生が5つの項目に正答する確率は次のとおり

theta（学力θ）	item1	item2	item3	item4	item5
-3	0.5737	0.2353	0.0815	0.3141	0.5203

• ここでの仮定：各項目に正答できるかどうかは互いに影響しない（＝局所独立）
  
• この学生が item1 から item4 まで正答、item5 には誤答する確率を計算してみる

\[item1の正答確率 × item2の正答確率 × item3の正答確率 × \\item4の正答確率 × item5の誤答確率（1-item5の正答確率）\] \[=0.5737×0.2353×0.0815×\\0.3141× (1-0.5203) = 0.001658 (=0.17\%)\]

・学力θが最も低い学生が、5問中4問に正答し1問だけ間違う確率は 0.17%

学力θが平均の学生（θ＝0）の正誤確率

• この学生が item5 に正答し、item1 から item4 までは誤答する確率を計算
• この学生が5つの項目に正答する確率は次のとおり

theta（学力θ）	item1	item2	item3	item4	item5
0	0.9412	0.9412	0.562	0.7833	0.8863

• ここでの仮定：各項目に正答できるかどうかは互いに影響しない（＝局所独立）
  
• この学生が item1 から item4 まで正答、item5 には誤答する確率を計算してみる

\[item1の正答確率 × item2の正答確率 × item3の正答確率 × \\item4の正答確率 × item5の誤答確率（1-item5の正答確率）\] \[=0.9412×0.9412×0.562×\\0.7833× (1-0.8863) = 0.034343 (=3.4\%)\]

0.034343

・学力θが平均的な学生が、5問中4問に正答し1問だけ間違う確率は3.4%

最も学力θが高い学生（θ= 3）の正誤確率

• この学生が item5 に正答し、item1 から item4 までは誤答する確率を計算
• この学生が5つの項目に正答する確率は次のとおり

theta（学力θ）	item1	item2	item3	item4	item5
3	0.9948	0.9593	0.9489	0.9661	0.9825

• ここでの仮定：各項目に正答できるかどうかは互いに影響しない（＝局所独立）
  
• この学生が item1 から item4 まで正答、item5 には誤答する確率を計算してみる

\[item1の正答確率 × item2の正答確率 × item3の正答確率 × \\item4の正答確率 × item5の誤答確率（1-item5の正答確率）\] \[=0.9948×0.9593×0.9489×\\0.9489× (1-0.9825) = 0.015338 (=1.5\%)\]

・学力θが最も低い学生が、5問中4問に正答し1問だけ間違う確率は 1.5%

• 上で紹介した「item1 から item5 までの正答確率」をもとに
  
• 学力θの値 (-3 から 3)ごとに、この学生の正誤パターン（正正正正誤）が起きる確率を計算してみる

ltm() 関数を使って（正正正正誤）が起こる確率を学力θごとに計算できる

• likelihood が学力θごとに推定された尤度

# 2PLモデルによるIRT分析（5項目に限定）
mod <- ltm(LSAT[, 1:5] ~ z1, IRT.param = TRUE)

# 能力値 θ の範囲指定
theta_vals <- seq(-3, 3, by = 0.1)

# モデルから項目パラメーター（a, b）を抽出
coefs <- coef(mod)  # col1 = b（困難度）, col2 = a（識別力）

# 回答パターン（1 = 正答, 0 = 誤答）
response_pattern <- c(1, 1, 1, 1, 0)

# 初期化：結果を格納するリスト
result_list <- list()

# 各θについて計算
for (j in seq_along(theta_vals)) {
  theta <- theta_vals[j]
  item_probs <- numeric(length(response_pattern))
  
  for (i in 1:length(response_pattern)) {
    b <- coefs[i, 1]
    a <- coefs[i, 2]
    P <- 1 / (1 + exp(-a * (theta - b)))
    
    # 正答なら P、誤答なら 1 - P を保存
    item_probs[i] <- ifelse(response_pattern[i] == 1, P, 1 - P)
  }
  
  # 尤度は5項目分の確率の積
  likelihood <- prod(item_probs)
  
  # 結果をデータフレーム形式で記録
  result_list[[j]] <- data.frame(
    theta = theta,
    Item1 = round(item_probs[1], 4),
    Item2 = round(item_probs[2], 4),
    Item3 = round(item_probs[3], 4),
    Item4 = round(item_probs[4], 4),
    Item5 = round(item_probs[5], 4),
    likelihood = round(likelihood, 6)
  )
}

# 全θの結果を結合して表示
result_df <- do.call(rbind, result_list)

DT::datatable(result_df)

• 学力θが 0.5の時、最も尤度が大きい (0.035957)

theta	item1	item2	item3	item4	item5	likelihood
0.5	0.9603	0.7944	0.667	0.836	0.0845	0.035957

• この学生が「item1に正答、item2に正答、item3に正答、item4に正答、item5に誤答」するのは
  →　この学生の学力θが 0.5の時に最も可能性が大きい (= 0.035957)
  →　この学生の学力は 0.5 と推定する

最尤推定法の基本的な考え方 ・学力 θ の候補値を −3 から 3 まで 0.1 ごとに調べる
・どの θ のときに「そのパターンの回答が起こる可能性（尤度:likelyhood）」が最も高くなるかを探す
・その「最も可能性が高いθ」が、学力（潜在特性）の推定値

「全問正答」や「全問誤答」の場合

• 学力θがどんなに大きくても、正答確率は 1 にはならない
  →　限りなく 1 に近づくだけ
  
• 学生がテストに全問に正答した場合、最尤推定法では学力θを推定できない
  
• 学生がテストに全問に誤答した場合、最尤推定法では学力θを推定できない
  
• 実際には「全問正答」や「全問誤答」もありうる
  →　最尤推定法を使って学力θを推定するのであれば
  →　受験する集団の学力を考慮して、次の二つを事前に決めておく必要がある
  ・全問正答の時の学力θ
  ・全問誤答の時の学力θ

6.7. テスト情報曲線 (TIC)

6.7.1 テスト情報曲線でわかること

このテストはどの能力レベルを正確に測れているか？

• IRTではテストの推定精度を計算できる
  = 指定した学力θがどの程度の「誤差」を含むかがわかる
  
• テストの測定精度のことを「テスト情報量」とも呼ぶ
  
• テスト情報量は学力θごとに計算できる

テスト情報関数 ・2パラメタ・ロジスティック・モデルの場合のテスト情報量は次の式で表せる

\[I(\theta) = 1.7^2\sum_{j=1}^na_j^2P_j(\theta)Q_j(\theta)\]

変数	内容
\(I(θ)\)	テスト情報量
1.7	定数
\(a_j\)	項目\(j\) の識別力
\(P_j(\theta)\)	学力θに応じた項目 \(j\) に正答する確率
\(Q_j(\theta)\)	学力θに応じた項目 \(j\) に誤答する確率

• IRTにおける措定精度は、個々の学力θに応じて計算できる

• 学力θごとに計算したテスト情報量
  →　テスト情報曲線 (Test Information Curve，TIC) で可視化する

• 「テストがどの能力レベル（θ）でどれくらい正確に測れているか」を可視化できる
  • 潜在特性値の値毎にテスト情報量を計算しプロットする
  

• tif関数を使ってテスト情報量を計算
  →　plot関数で TIC を作成

• 様々な潜在特性値\(θ\)（能力）におけるテスト情報量（Information）が I

• irtoysパッケージの tif()関数を使って計算する

I <- irtoys::tif(ip = ex1$est) # データに対し2PLMを仮定
                           # x: tif関数で推定した結果を指定する引数
plot(x = I)                # ip: テストに含まれる各項目の項目パラメーターを指定する引数 

・横軸・・・潜在特性値\(θ\)（学力）
・縦軸・・・テスト情報量（測定の精度＝標準誤差の逆数）
・実線・・・テスト情報曲線
→　当該潜在特性値におけるテスト情報量をつなぎ合わせたもの

テスト情報曲線 (TIC) でわかること 1. どの能力レベルを正確に測れているか？
・情報量が高いところ → その学力θレベルでテストが精度が高い
→ \(\theta = −2\)付近の情報量が最も高い
→ \(\theta = −2\)付近のレベルでテストが高精度

・情報量が低いところ
→ その学力θレベルではテストの精度が低い
→ \(\theta = 4\)の情報量が最も低い
→ \(\theta = 4\)のレベルでテストが低精度

例：TICがθ = 0の周辺で高ければ
→「平均的な人を測るのに最適なテスト」だといえる

2. テストの設計意図が見える
・TICがどこで山になるかを見ることで、そのテストがどんな対象向けかが分かる
・TICが\(\theta = −2\)付近で山になっている
→　このテストは比較的能力の低い人向け

・TICがどこで山になるかを見ることで
→ そのテストがどんな対象向けかが分かる

TICの山の位置	意味	対象
θ = 0 周辺	平均均的な受験者向け	一般的な学力テスト
θ > 0（右寄り）	高能力者向け	難関資格・上級試験
θ < 0（左寄り）	初級者・低能力者向け	基礎力診断など

・ここではTICの山の位置が左より
→　平均均的な受験者向けだとわかる

3. 信頼性の高さ（精度）もわかる
・情報量が高い＝その範囲の 標準誤差（SE）が小さい
・標準誤差との関係：

\[SE(\theta) = \frac{1}{\sqrt{{I(\theta)}}}\]

・つまり、情報量が大きいと \(\theta\) の推定がブレにくい（= 信頼できる）

4. テスト情報量の基準を設定する：0.5以上

・例えば、テスト情報量の基準を「0.5以上」と設定する
→　情報精度の基準を満たしている学力θの範囲がわかる

項目適合度の結果のポイント どの潜在特性値 \(\theta\) の値で、情報量が最大になるか
・潜在特性値が −2 の辺りでテスト情報量が最大
⇒ 潜在特性値\(θ\)（能力）が低い（ −2 の辺り ）受験者の推定精度が最も高い

6.7.2 テストの実施目的とテスト情報量

左側の図:

• 「困難度」が同じで「識別力」が異なる場合のテスト情報量
  
• 学力θが 0 付近の標高が高く、高く切り立った山
  →　学力θが 0 付近の「狭い範囲の学力」を「高い精度で」を測定することに適している（例えば、選抜テストなど）

右側の図:

• 「識別力」が同じで「困難度」が異なる場合のテスト情報量
  
• 学力θが 0 付近の標高が高く、高く切り立った山
  →　学力θが 0 付近の「広い範囲の学力」を「一定の精度で」を測定することに適している（例えば、基礎力を測る学力テストなど）

潜在特性値（学力θ）の推定:mlebme()

• Rで潜在特性値を推定する
  • mlebme関数を利用して潜在特性値を推定
  ⇒ mlebme関数はirtoysパッケージの中に入っている関数

head(mlebme(resp = LSAT[, 1:5],　# テストデータを指定
  ip = ex1$est,       # データに対し2PLMを仮定
  method = "BM"))           # 最尤推定法 (ML) による潜在特性値の推定を指定

           est       sem n
[1,] -1.895392 0.7954829 5
[2,] -1.895392 0.7954829 5
[3,] -1.895392 0.7954829 5
[4,] -1.479314 0.7960948 5
[5,] -1.479314 0.7960948 5
[6,] -1.479314 0.7960948 5

• resp: テストデータを指定する引数
  
• ip: テストに含まれる各項目の項目パラメーターを指定する引数
  
• ex1$est と指定
  →　データに対し2PLMを仮定したときの項目パラメーターの推定値が各項目の項目パラメーターとして指定
  
• 項目パラメーターを推定した後に、潜在特性値の推定を行う
  
• method: どの推定法を用いて潜在特性値を推定するか
  
• ML と指定
  →　最尤推定法による潜在特性値の推定を指定
  ⇒ 全問正答/誤答の受験者がいる場合、コれらの受験者の推定値が求まらない
  
• BM と指定
  →　潜在特性値が標準正規分布に従っていることを仮定しているという情報を加味して推定が行えるようになり（事前情報）
  →　全問正答/誤答の受験者に対しても推定値を得ることができる（ベイズ推定）

theta.est <- mlebme(resp = LSAT[,1:5],
  ip = ex1$est,
  method="BM")

DT::datatable(theta.est)

• １列目：推定値 (est)
  
• ２列目：標準誤差 (sem)
  
• ３列目：解答した項目 (n)

6.8 局所独立性の検討: irf() & cor()

6.8.1 局所独立性とは

• IRTに基づきテストデータや質問紙への回答を分析する
  ⇒ 局所独立性が仮定されている
  • IRTにおける局所独立性の検討
  
• 潜在特性値 \(\theta\) の値を固定したとき、項目相互間で解答が独立に生じている仮定を満たすこと
  
• 「局所独立の仮定」とは「一次元性の仮定」のこと

一次元性の仮定 各項目の正誤が、潜在特性値 \(\theta\) の値の大小によってのみばらつく

• つまり「受験者が正解するかどうかは、受験者の能力だけで決まる」という仮定

• 局所独立性の検討は \(Q_3\)統計量に基づいて行われることが多い
• \(Q_3\)統計量とは、各項目への回答（観測値）からその期待値を引き
→　得られた残差得点間の相関を求めることで得られる
- \(Q_3\)統計量は、各項目への反応（= 観測値） からその期待値（= 項目反応モデルにより計算される正答確率）を引き
→　得られた残差得点間の相関を求めることで得られる統計量
- その絶対値が 0 に近いほど、項目反応間に局所独立性を仮定できる

• たとえば今の場合、item1 の残差得点\(d_1\)は次の式で表せる

\[d_1 = u_1 - \hat{P_1(\theta)}\]

• \(u_1\): item1 への解答結果（正答なら１、誤答なら０）
  
• \(\hat{P_1(\theta)}\): 項目パラメーターと潜在特性の推定値から計算される正答確率

6.8.2 Rで \(Q_3\) 統計量を計算する方法

Step 1. irf関数を利用して正答確率 ($f) を推定

• irf関数では2PLMを仮定
• ex1$est と指定
→　データに対し2PLMを仮定したときの項目パラメーターの推定値を各項目の項目パラメーターとして指定
• theta.est[, 1] と指定
→　データに対し2PLMを仮定したときの潜在特性の推定値を指定

⇒ 結果はPとして保存

P <- irf(ip = ex1$est, # 項目パラメーターを指定
  x = theta.est[, 1])  # 各受験者の潜在特性値を指定

変数	内容
$x	各受験者の潜在特性値\(\theta\)（能力）
$f	正答確率の推定値
行	受験者 (1,000名)
列	項目 (item1〜item5)

Step 2. 推定された正答確率とテストデータより、残差得点 \(d\) を算出

• \(d_j = u_j - \hat{P_j(\theta)}\) の値を計算して \(d\) として保存 (1 ≦ j ≦5 )
• P$fと指定することで，正答確率の推定値が抽出される
  ⇒ テストデータ (LSAT,1:5]) から正答確率を引いた残差得点を \(d\) に保存

d <- LSAT[, 1:5] - P$f # P$f と指定して正答確率の推定値を得る  

• 1,000人の受験生の最初の6人分の計算結果を表示させてみる

head(d)

       item1      item2      item3      item4      item5
1 -0.7700558 -0.4061064 -0.1917689 -0.4949268 -0.6915701
2 -0.7700558 -0.4061064 -0.1917689 -0.4949268 -0.6915701
3 -0.7700558 -0.4061064 -0.1917689 -0.4949268 -0.6915701
4 -0.8252089 -0.4801900 -0.2557741 -0.5661590  0.2533129
5 -0.8252089 -0.4801900 -0.2557741 -0.5661590  0.2533129
6 -0.8252089 -0.4801900 -0.2557741 -0.5661590  0.2533129

受験者1のitem1 に関する残差得点 \(d_{11}\)をチェック ・例えば、受験者1のitem1 に関する残差得点 \(d_1\) は -0.7700558
・受験者1の item1 への回答 \(u_{ij} = u_{11}\) を確認してみる

LSAT[1,1]

[1] 0

• 受験者1の item1 への回答は 0（誤り）
  
• 受験者1の item1 に関する正答確率の推定値 \(\hat{P_{11}(\theta)}\) は0.7700558（上の図を参照）
  →　受験者1の残差得点 \(d_{11}\) は

LSAT[1,1] - 0.7700558

[1] -0.7700558

Step 3. cor関数を利用して \(Q_3\) 統計量の値を計算

Q3 <- cor(x = d, 
  y = d, 
  use = "pairwise.complete.obs")

Q3

            item1       item2       item3        item4        item5
item1  1.00000000 -0.04142824 -0.04101429 -0.064167975 -0.062538809
item2 -0.04142824  1.00000000 -0.11322248 -0.097060194 -0.029585197
item3 -0.04101429 -0.11322248  1.00000000 -0.092262203 -0.104216701
item4 -0.06416797 -0.09706019 -0.09226220  1.000000000 -0.003656669
item5 -0.06253881 -0.02958520 -0.10421670 -0.003656669  1.000000000

局所独立性の検討のポイント 各項目の正誤が、潜在特性値 \(\theta\) の値の大小によってのみばらつくかどうか
。\(Q_3\) の絶対値が 0 に近いほど、項目反応間に局所独立性を仮定できる
・\(Q_3\) の値の絶対値が 0.2以上の場合　→　問題あり: 局所依存性の疑い（Chen & Thissen, 1997）
・\(Q_3\) の値の絶対値が 0.2以下の場合　→　問題なし

→　ここでは\(Q_3\) の値の絶対値が全て 0.2以下　→　問題なし
→　局所独立性が成立していることを示唆
→　次の分析に移る

・局所依存性：局所独立性が満たされていない状態のこと
⇒ \(Q_3\)はあくまで一つの基準に過ぎないので注意が必要

6.9 項目適合度の検討: itf()

・「各項目が理論モデル（例：2PLモデル、3PLモデル）にちゃんと従っているかどうか」を評価するものが項目適合度 (Item Fit)
• IRTにおいては項目反応モデルへの適合度を検討することも重要

• ここでは、itf関数を利用して item1 の項目適合度を検討してみる

• resp はテストデータを指定する引数

irtoys::itf(resp = LSAT[, 1:5], # 応答データ [受験者, 項目]  
  item = 1,                     # 1番目の項目適合度の検討を指定する
  ip = ex1$est, 　　　　   # 2PLモデルによる推定された項目パラメータ
  theta = theta.est[, 1])       # 受験者ごとの能力推定値（θ）

 Statistic         DF    P-value 
10.0741811  6.0000000  0.1215627 

• 図は、当てはめた項目反応モデルとデータとの乖離度を示している
  
• 横軸・・・潜在特性値 (Ability) 　　
• 縦軸・・・正答確率 (Proportion right)
  
• 実線・・・当てはめた項目反応モデルに基づく正答確率の予測値
  
• 円・・・潜在特性の推定値に基づき受験者を群分けした際の群ごとの実際の正答率
  • 潜在特性値\(θ\)（能力）は平均０、分散１

項目適合度でわかること
その項目がIRTモデルに「合っているか」どうか
・各項目の「実際のデータによる反応パターン」と、IRTモデルが「理論的に予測する反応パターン」を比較
→　もしズレていたら、モデルの仮定がその項目には合っていないということ

なぜ重要？

・モデルに合っていない項目を使うと、潜在特性値\(θ\)（能力）の推定が不正確になる可能性あり
・項目の品質をチェックし、不適切な項目を修正・削除する判断材料になる
・バイアスの検出（DIF：Differential Item Functioning）の手がかりにもなる

適合度が悪いときに考えられること

現象	可能性
実際の正答率がモデルより低い	問題文がわかりにくい／迷いやすい選択肢
特定の能力層だけ挙動がおかしい	バイアスがある、ミスリードされやすい項目
正答率がランダムに近い	推測が強く影響（cパラメータが不十分）
認知的に複雑すぎる	単一の「能力θ」では説明できない

適合度を判断する指標： S-X²統計量（Orlando & Thissenの項目適合度指標）
・より精度の高い適合度検定（特に2PLや3PLに使う）
・能力をグループ（通常は10分位など）に分け
→　各グループでのモデルによる期待正答率と、実際の正答率の差を使う
→　カイ二乗型の統計量として適合度を評価
＝　これは、カイ二乗分布に従う統計量だが、S-X²特有の方法
→　通常のカイ二乗適合度検定とは区別される

結果の解釈

\[ 帰無仮説: 「当てはめたモデルがデータに適合している」\]

得られた結果:

• p値が有意水準 (0.05) よりも大きい: p-value = 0.1215627
  →　帰無仮説は棄却できない
  → 「当てはめた項目反応モデルがデータに適合している」と判断される

• itf 関数を使用した際に出力される図において
  

• 実線と円の間の乖離が大きいほど、モデルがデータに当てはまっていないと判断

6.10 テスト特性曲線（TCC）の作成:

能力\(\theta\)の人がどれくらい得点できるのか？

• trf() & plot()関数を使った分析
  • 潜在特性値の値毎に素点の期待値を計算しプロットする

• trf関数を使ってテスト情報量を計算
  →　plot関数で TCC を作成

E <- trf(ip = ex1$est)  # データに対し2PLMを仮定
                             # ip: テストに含まれる各項目の項目パラメーターを指定する引数
plot(x = E)                  # 様々な潜在特性値における素点の期待値（Expectation）

横軸・・・潜在特性値 (Ability)
縦軸・・・予想される合計得点 (Expected Score)

テスト特性曲線 (TCC) でわかること 1. 受験者の能力 \(\theta\) と期待得点の関係

・実線が右肩上がり
→　受験者の能力が上がるにつれて、得点も上がる傾向あり

2. テストの難易度と分布の様子
・受験者の能力 \(\theta\) が 0 のあたりで急に得点が上がっている場合
→　平均的な能力の人向けのテスト
・受験者の能力 \(\theta\) が 2 〜 4 のあたりで急に得点が上がっている場合
→　平均以上の能力の人向けのテスト
・受験者の能力 \(\theta\) が −4 〜 −2 のあたりで急に得点が上がっている場合
→　平均以下の能力の人向けのテスト

3. 得点分布の歪みや限界
・TCCの傾きが緩やかな部分
→　その能力帯では得点の変化が鈍い（= 差がつきにくい）
・予想される合計得点に近い部分が平坦になっている場合は
→　高得点者と低得点者の差がつきにくい

7. 実際のテストデータを使った IRT 分析演習

• 220人が受験した試験結果 (irt_was.csv)
  
• 含まれている変数は 41 個 (name, Q1, Q2, …, Q40)
  
• 回答結果は 1 が正答、0 が誤答

変数名	詳細
ID	受験者のID
Q1 〜 Q40	1番目から40番目の回答結果 (0 or 1)

• データを読み込み df1 と名前を付ける

df1 <- read_csv("data/irt_was.csv")

DT::datatable(df1)

• Q1からQ40までの総合点 total を作成して df1 に加える

df1 <- df1 |> 
  dplyr::mutate(total = rowSums(dplyr::across(Q1:Q40), 
    na.rm = TRUE))     

• Q1（＝2行目）から Q40（＝41行目）までのスコアの平均値を計算し、crr1 と名前を付ける

crr1 <- colMeans(x = df1[2:41],
  na.rm = TRUE)

• 計算された値 (crr1) では使い勝手が悪いのでデータフレームに変換して df_crr1 と名前を付ける

df_crr1 <- data.frame(      # データフレーム名を指定（ここでは df_crr1 と指定）
  item = names(crr1),       # 変数名を指定（ここでは item と指定）
  seikai = as.numeric(crr1) # 変数名を指定（ここでは seikai と指定）
)

• df_crr1 の中身を確認

df_crr1

   item     seikai
1    Q1 0.74429224
2    Q2 0.88181818
3    Q3 0.89545455
4    Q4 0.37440758
5    Q5 0.41395349
6    Q6 0.58490566
7    Q7 0.83944954
8    Q8 0.56164384
9    Q9 0.59345794
10  Q10 0.46575342
11  Q11 0.24423963
12  Q12 0.56422018
13  Q13 0.59907834
14  Q14 0.22272727
15  Q15 0.90909091
16  Q16 0.81818182
17  Q17 0.35944700
18  Q18 0.76712329
19  Q19 0.59090909
20  Q20 0.63181818
21  Q21 0.09090909
22  Q22 0.78082192
23  Q23 0.71818182
24  Q24 0.16513761
25  Q25 0.21395349
26  Q26 0.30875576
27  Q27 0.08256881
28  Q28 0.33018868
29  Q29 0.93636364
30  Q30 0.97272727
31  Q31 0.94090909
32  Q32 0.38028169
33  Q33 0.74885845
34  Q34 0.36073059
35  Q35 0.84474886
36  Q36 0.04629630
37  Q37 0.95890411
38  Q38 0.84792627
39  Q39 0.86697248
40  Q40 0.07407407

• 棒グラフで可視化する
  
• seikai の値が大きい順に並べ替えて表示させる
  
• seikai の値が大きい順に因子の順序を指定

df_crr1$item <- factor(df_crr1$item, 
  levels = df_crr1$item[order(df_crr1$seikai)])

ggplot(df_crr1, aes(x = seikai, y = item)) +
  geom_bar(stat = "identity", fill = "skyblue") +
  geom_text(aes(label = round(seikai, 2)),  # 小数第2位で丸める
            hjust = -0.2, size = 3) +        # 棒の内側に表示
  labs(
    title = "各項目の正答率",
    x = "項目",
    y = "正答率"
  ) +
  theme_minimal() +
  theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策  

• Q30の正解率が最も高く(97%)、Q36の正解率が最も低い (0.5%)

正答率の計算のポイント ・極端に正答率の高い/低い項目があるかどうか
・極端に高い/低い項目がある場合　→　問題あり
・極端に高い/低い項目がない場合　→　問題なし ・ここでは次の項目をチェックする
→　極端に高い項目（90%以上の正答率）・・・Q30〜Q3
→　極端に低い項目（10%以下の正答率）・・・Q21〜Q36

解決策：

・Q21, Q27, Q36, Q40 は解答が間違っていた　→　分析から削除

→　次の分析に移る

• df1からQ21, Q27, Q36, Q40を削除し、df2 として保存

df2 <- df1 |> 
  dplyr::select(-Q21, -Q27, -Q36, -Q40)

dim(df1)

[1] 220  42

dim(df2)

[1] 220  38

• 各項目の正答率を再度、表示させてみる

df_filtered <- df_crr1 %>%
  filter(!(item %in% c("Q21", "Q27", "Q36", "Q40")))

ggplot(df_filtered, aes(x = seikai, y = item)) +
  geom_bar(stat = "identity", fill = "skyblue") +
  geom_text(aes(label = round(seikai, 2)),
            hjust = -0.2, size = 3) +
  labs(
    title = "各項目の正答率",
    x = "正答率",
    y = "項目"
  ) +
  theme_minimal() +
  theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策

• 解答が間違っていたQ21, Q27, Q36, Q40 が削除されていることがわかる
  

• 以後、これらのデータを除いた df2 を使ってする

• df1からQ21, Q27, Q36, Q40を削除したデータフレーム df2の「列番号」と「項目番号」は次のとおり

7.2 I-T相関の計算: cor()

• cor()関数を使って、素点 (Q1 〜 Q39) と合計点 total との相関を計算
  
• Q1 〜 Q39の位置（＝列番号）を確認

dim(df2)

[1] 220  38

DT::datatable(df2)

• 受験生は 220名
  

• Q1・・・2列目
  

• Q39・・・37列目
  

• total・・・38列目
  

• 次の二つの相関を計算する

• Q1（＝2番目の項目）〜 Q39（＝37番目の項目）
  

• Q40（＝38番目の項目）

it2 <- cor(x = df2[, 2:37], 
  y = df2[, 38],
  use = "pairwise.complete.obs")

it2

         total
Q1  0.29534266
Q2  0.32266598
Q3  0.26012027
Q4  0.50261700
Q5  0.19305486
Q6  0.27121937
Q7  0.27827906
Q8  0.13387547
Q9  0.41990046
Q10 0.38089218
Q11 0.15215899
Q12 0.36024531
Q13 0.23155032
Q14 0.22558607
Q15 0.43006775
Q16 0.29335063
Q17 0.36182184
Q18 0.41352190
Q19 0.41045361
Q20 0.57598186
Q22 0.39598885
Q23 0.40634153
Q24 0.01792600
Q25 0.09606271
Q26 0.03272115
Q28 0.22223712
Q29 0.28809415
Q30 0.29538906
Q31 0.18119271
Q32 0.25220315
Q33 0.41950415
Q34 0.27577137
Q35 0.34093707
Q37 0.18087365
Q38 0.28079180
Q39 0.32378818

• ここで得られた結果 it2 は「行名付きの1列行列（matrix）」
  →　使い勝手が悪いので、この matrix をデータフレームに変換して、行名を項目名の列として追加する

# 行列をデータフレームに変換
df_it2 <- as.data.frame(it2)

# 行名を項目名として列に追加
df_it2$item <- rownames(df_it2)

# 列名をわかりやすく変更（オプション）
colnames(df_it2) <- c("correlation", "item")

• 相関係数が低い順位並べ変えて表示させてみる
  
• correlation の値順に因子の順序を指定

df_it2$item <- factor(df_it2$item, 
  levels = df_it2$item[order(df_it2$correlation)])

ggplot(df_it2, aes(x = correlation, y = item)) +
  geom_bar(stat = "identity", fill = "orange") +
  geom_text(aes(label = round(correlation, 3)), 
    hjust = -0.2, size = 3) +
  xlim(0, 0.65) +
  labs(
    title = "項目－合計相関（item-total correlation）",
    x = "項目",
    y = "相関係数"
  ) +
  theme_minimal() +
  theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策  

• 素点 (Q1 〜 Q39) と各項目得点 (total) との相関は 0.018と0.576の間

・各項目への反応 (Q1 〜 Q39) と合計点 (total) との間にI-T 相関の度合いは妥当？

IT相関値	評価	項目の扱い	該当項目
〜 0.2	極めて低い（要注意）	除外を検討する	Q24, Q26, Q25, Q8, Q11, Q37, Q5
0.2〜0.3	やや低い	内容によって再検討
0.3〜0.4	妥当なレベル	保留・文脈による判断
0.4以上	良好（望ましい）	採用して問題なし	Q20, Q4, Q15, Q9, Q33, Q18, Q19, Q23

→　ここでは0.2 以下の相関の項目が7つ　→　除外を検討

7.4 項目パラメーターの推定

• ここでは 2 パラメタ・ロジスティックモデル (2PL: 一般化ロジスティックモデル)を使って分析する

• データフレーム df2 を確認

dim(df2)

[1] 220  38

• 2列から37列まで 37 - 2 = 35 で、項目数は 34

DT::datatable(df2)

• ltm パッケージの est()関数で項目パラメーターを推定する
  →　ex2 として保存

ex2 <- est(resp = df2[, 2:37], # テストデータを指定する引数
  model = "2PL",        # 2PLMを仮定
  engine = "ltm")　# ltmパッケージを利用して項目母数を推定すると指定

ex2

$est
           [,1]        [,2] [,3]
Q1   0.83101563  -1.4837419    0
Q2   1.38529706  -1.8868385    0
Q3   0.96083273  -2.5781569    0
Q4   1.17398639   0.5348538    0
Q5   0.30308003   1.1720583    0
Q6   0.40541452  -0.8908177    0
Q7   0.84944311  -2.2112025    0
Q8   0.21668701  -1.1654871    0
Q9   1.02539301  -0.4665746    0
Q10  0.84664746   0.1589867    0
Q11  0.19059685   5.9706787    0
Q12  0.75312216  -0.4032208    0
Q13  0.08718103  -4.6166578    0
Q14  0.56079979   2.3682460    0
Q15  2.66234874  -1.5583871    0
Q16  0.99818390  -1.7964914    0
Q17  0.84008267   0.7663600    0
Q18  1.40381366  -1.1669284    0
Q19  0.48693593  -0.8133296    0
Q20  1.98871836  -0.4996180    0
Q22  1.35340407  -1.2622575    0
Q23  0.96305339  -1.1754989    0
Q24 -0.08172114 -19.8650474    0
Q25  0.03501333  37.1694908    0
Q26 -0.30777475  -2.6872822    0
Q28  0.02950535  23.9739215    0
Q29  1.55000393  -2.2765012    0
Q30  3.98038339  -1.9469339    0
Q31  0.76696232  -3.9245301    0
Q32  0.62852045   0.8365656    0
Q33  1.34152251  -1.1021836    0
Q34  0.15013542   3.8197754    0
Q35  1.08891672  -1.8915249    0
Q37  0.84665151  -4.0757930    0
Q38  0.79165359  -2.4259284    0
Q39  1.06302106  -2.1052554    0

$se
           [,1]        [,2] [,3]
 [1,] 0.2338576   0.3801713    0
 [2,] 0.3987228   0.3810303    0
 [3,] 0.3385227   0.7379581    0
 [4,] 0.2338250   0.1738089    0
 [5,] 0.1607692   0.7590312    0
 [6,] 0.1691979   0.4897666    0
 [7,] 0.2761040   0.6118341    0
 [8,] 0.1581844   1.0400471    0
 [9,] 0.2280855   0.1751453    0
[10,] 0.1980058   0.1896641    0
[11,] 0.1786044   5.5714769    0
[12,] 0.1942374   0.2162077    0
[13,] 0.1614898   8.6640289    0
[14,] 0.1947492   0.7913817    0
[15,] 0.7785051   0.2066898    0
[16,] 0.2852876   0.4183951    0
[17,] 0.2002724   0.2464511    0
[18,] 0.3247702   0.2081203    0
[19,] 0.1829278   0.3981055    0
[20,] 0.4084806   0.1163234    0
[21,] 0.3245696   0.2318685    0
[22,] 0.2397270   0.2718255    0
[23,] 0.2078260  50.4074626    0
[24,] 0.1857672 197.1842928    0
[25,] 0.1780322   1.5581067    0
[26,] 0.1656170 134.6250212    0
[27,] 0.5180435   0.5006750    0
[28,] 1.8721125   0.2602029    0
[29,] 0.4029644   1.7995226    0
[30,] 0.1808207   0.3242469    0
[31,] 0.3129724   0.2088459    0
[32,] 0.1631607   4.2265221    0
[33,] 0.3145162   0.4288678    0
[34,] 0.4816135   1.9908538    0
[35,] 0.2748202   0.7268334    0
[36,] 0.3270586   0.5094791    0

$vcm
$vcm[[1]]
           [,1]       [,2]
[1,] 0.05468939 0.07445014
[2,] 0.07445014 0.14453019

$vcm[[2]]
          [,1]      [,2]
[1,] 0.1589799 0.1342853
[2,] 0.1342853 0.1451841

$vcm[[3]]
          [,1]      [,2]
[1,] 0.1145976 0.2352867
[2,] 0.2352867 0.5445822

$vcm[[4]]
            [,1]        [,2]
[1,]  0.05467412 -0.01872764
[2,] -0.01872764  0.03020952

$vcm[[5]]
            [,1]        [,2]
[1,]  0.02584675 -0.09621237
[2,] -0.09621237  0.57612836

$vcm[[6]]
           [,1]       [,2]
[1,] 0.02862794 0.05677026
[2,] 0.05677026 0.23987132

$vcm[[7]]
          [,1]      [,2]
[1,] 0.0762334 0.1558379
[2,] 0.1558379 0.3743410

$vcm[[8]]
          [,1]      [,2]
[1,] 0.0250223 0.1302215
[2,] 0.1302215 1.0816979

$vcm[[9]]
           [,1]       [,2]
[1,] 0.05202298 0.01415844
[2,] 0.01415844 0.03067586

$vcm[[10]]
             [,1]         [,2]
[1,]  0.039206302 -0.008202823
[2,] -0.008202823  0.035972456

$vcm[[11]]
            [,1]       [,2]
[1,]  0.03189952 -0.9838605
[2,] -0.98386055 31.0413548

$vcm[[12]]
           [,1]       [,2]
[1,] 0.03772815 0.01413777
[2,] 0.01413777 0.04674576

$vcm[[13]]
           [,1]      [,2]
[1,] 0.02607895  1.375339
[2,] 1.37533850 75.065397

$vcm[[14]]
            [,1]       [,2]
[1,]  0.03792726 -0.1421844
[2,] -0.14218437  0.6262850

$vcm[[15]]
          [,1]       [,2]
[1,] 0.6060702 0.12211463
[2,] 0.1221146 0.04272067

$vcm[[16]]
           [,1]      [,2]
[1,] 0.08138904 0.1051536
[2,] 0.10515363 0.1750545

$vcm[[17]]
            [,1]        [,2]
[1,]  0.04010902 -0.03053288
[2,] -0.03053288  0.06073814

$vcm[[18]]
           [,1]       [,2]
[1,] 0.10547568 0.04825235
[2,] 0.04825235 0.04331407

$vcm[[19]]
           [,1]       [,2]
[1,] 0.03346259 0.04856354
[2,] 0.04856354 0.15848797

$vcm[[20]]
           [,1]       [,2]
[1,] 0.16685640 0.01270551
[2,] 0.01270551 0.01353113

$vcm[[21]]
           [,1]       [,2]
[1,] 0.10534545 0.05702124
[2,] 0.05702124 0.05376299

$vcm[[22]]
           [,1]       [,2]
[1,] 0.05746904 0.04876296
[2,] 0.04876296 0.07388908

$vcm[[23]]
             [,1]       [,2]
[1,]   0.04319165  -10.46569
[2,] -10.46568747 2540.91229

$vcm[[24]]
             [,1]        [,2]
[1,]   0.03450945   -36.61974
[2,] -36.61973784 38881.64534

$vcm[[25]]
            [,1]       [,2]
[1,]  0.03169548 -0.2635148
[2,] -0.26351485  2.4276966

$vcm[[26]]
             [,1]        [,2]
[1,]   0.02742898   -22.28111
[2,] -22.28110624 18123.89632

$vcm[[27]]
          [,1]      [,2]
[1,] 0.2683691 0.2366886
[2,] 0.2366886 0.2506755

$vcm[[28]]
          [,1]       [,2]
[1,] 3.5048053 0.37991626
[2,] 0.3799163 0.06770557

$vcm[[29]]
          [,1]     [,2]
[1,] 0.1623803 0.708381
[2,] 0.7083810 3.238282

$vcm[[30]]
            [,1]        [,2]
[1,]  0.03269611 -0.03853284
[2,] -0.03853284  0.10513604

$vcm[[31]]
           [,1]       [,2]
[1,] 0.09795175 0.04634588
[2,] 0.04634588 0.04361663

$vcm[[32]]
            [,1]       [,2]
[1,]  0.02662141 -0.6722509
[2,] -0.67225093 17.8634891

$vcm[[33]]
           [,1]      [,2]
[1,] 0.09892042 0.1201392
[2,] 0.12013920 0.1839276

$vcm[[34]]
          [,1]      [,2]
[1,] 0.2319515 0.9379179
[2,] 0.9379179 3.9634987

$vcm[[35]]
           [,1]      [,2]
[1,] 0.07552614 0.1869027
[2,] 0.18690270 0.5282868

$vcm[[36]]
          [,1]      [,2]
[1,] 0.1069673 0.1518345
[2,] 0.1518345 0.2595690

7.5 項目特性曲線 (ICC)

• ここでは 35 項目の「識別力a」と「困難度b」が計算できた
  
• 35 項目の特性曲線を描いてみる

ex2 <- est(resp = df2[, 2:37], # テストデータを指定する引数
  model = "2PL",      　　　   # 2PLMを仮定
  engine = "ltm")　            # ltmパッケージを利用して項目母数を推定すると指定

P2 <- irf(ip = ex2$est) # irf()関数を使って正答確率を計算  

plot(x = P2,     # xは引数、irf関数で推定した結果を指定する
  co = NA,      # ICCの色を指定/項目毎に異なる色でICCを描く
  label = TRUE) # 各ICCに項目の番号がつく

abline(v = 0, lty    = 2) # x = 0 の縦点線を引く

横軸・・・潜在特性値 \(θ\) (Ability)
縦軸・・・正答確率 (Probability of a correct response)

• ここに表示された番号は「項目名」(Q1,….Q40) ではなく、列番号 (1,…,37)
  
• 列番号でなく「項目名」(Q1,….,Q40) を表示させたい
  
• Q21, Q27, Q36, Q40 を削除したので、それを調整する必要あり

library(ltm)

# 欠損しているQ番号を除く35項目名を指定
item_names <- paste0("Q", 
  setdiff(1:40, c(21, 27, 36, 40)))

# 項目名を設定
colnames(df2)[2:37] <- item_names

# ltm() を使って推定（欠損値対応）
mod <- ltm(df2[, 2:37] ~ z1, 
  IRT.param = TRUE)

# 正しく項目名で表示されるICCを描画
plot(mod, cex = 0.6)

abline(v = 0, lty    = 2) # x = 0 の縦点線を引く

• 例えば、Q26の曲線は左上から右下に下がっている → 能力の高まるほど正答率が下がる
  
• Q26の識別力は -0.30777475

識別力 a の解釈：

・項目が能力をどれだけ区別できるかを示すパラメータ

適切な識別力 a の大きさ

0.3 〜 2.0

（出典：芝祐順編『項目反応理論』p.34）

• 識別力を可視化
  
• 適切な識別力 a の上限と下限に赤の点線を引く

library(irt)
library(ggplot2)
library(dplyr)

# モデル推定（再掲）
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 識別力（aパラメータ）を取り出す
discrimination <- ex2$est[, 1]

# データフレーム化
disc_df <- data.frame(
  Item = rownames(ex2$est),
  Discrimination = discrimination
) %>%
  arrange(Discrimination) %>%
  mutate(Item = factor(Item, levels = Item))  # 並び順固定

# ラベルを左右に分けるため、hjust列を作成
disc_df <- disc_df %>%
  mutate(
    hjust_pos = ifelse(Item %in% c("Q24", "Q26"), 1.1, -0.1)  # Q24とQ26だけ左側に、それ以外は右側に
  )

# グラフ描画
ggplot(disc_df, aes(x = Discrimination, y = Item)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_text(
    aes(label = round(Discrimination, 2), hjust = hjust_pos),
    size = 3
  ) +
  geom_vline(xintercept = 0.3, color = "red", linetype = "dashed", size = 0.5) +
  geom_vline(xintercept = 2.0, color = "red", linetype = "dashed", size = 0.5) +
  labs(
    title = "識別力の大きさ順に並べた項目",
    x = "識別力",
    y = "項目"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  coord_cartesian(xlim = c(min(disc_df$Discrimination) - 0.5, max(disc_df$Discrimination) + 0.5))  # 余白確保

識別力が 0.3 以下の項目の ICC

• Q8, Q11, Q34, Q13, Q25, Q28, Q24, Q26 だけを ICC曲線として描く

library(irt)
library(ggplot2)
library(dplyr)

# 1. モデル推定（再掲）
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 2. パラメータ抽出（a=識別力, b=困難度）
param_df <- data.frame(
  Item = rownames(ex2$est),
  Discrimination = ex2$est[, 1],  # aパラメータ
  Difficulty = ex2$est[, 2]       # bパラメータ
)

# 3. 識別力が0.3以下の項目だけ抽出
low_disc_items <- param_df %>%
  filter(Discrimination <= 0.3)

# 4. θの範囲を設定
theta_vals <- seq(-4, 4, length.out = 200)

# 5. 各項目のICCを計算
icc_list <- lapply(1:nrow(low_disc_items), function(i) {
  a <- low_disc_items$Discrimination[i]
  b <- low_disc_items$Difficulty[i]
  item_name <- low_disc_items$Item[i]
  
  P <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLのICC公式
  data.frame(
    theta = theta_vals,
    Probability = P,
    Item = item_name
  )
})

# 6. データ結合
icc_long <- bind_rows(icc_list)

# 7. ラベル位置データ作成
label_positions <- icc_long %>%
  group_by(Item) %>%
  filter(theta == max(theta)) %>%  # θ = 4 の位置
  ungroup()

# 8. ICC描画
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1.2) +
  geom_text(
    data = label_positions,
    aes(label = Item),
    hjust = -0.1,
    vjust = 0,
    size = 3,
    show.legend = FALSE
  ) +
  scale_y_continuous(limits = c(0, 1)) +  # ★ ここでy軸を0〜1に固定 ★
  labs(
    title = "識別力が0.3以下の項目のICC",
    x = expression(theta),
    y = "正答確率"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme(legend.position = "none")  # 凡例を消してスッキリ

識別力2.0以下の項目の評価
- 識別力は、受験者のθ（能力）による正答確率の変化の鋭さを表す
- 識別力が高いと　→　能力の違いに敏感に反応する
→　θが少し上がるだけで正答率が大きく上がる
- 識別力が低い（0.3以下）と
→　θが変わっても正答確率があまり変わらない＝「区別がつかない」
・Q26の識別力は -0.30777475
→　識別力がマイナスの値　→　能力が高いほど正答率が高いということ
・識別力が小さくても、正答率が高ければ「基礎知識の確認問題」と位置づけて残すことも可能

結論：

・Q24とQ26・・・識別力がマイナス（異常値）なので除外
・Q34, Q11, Q28, Q25・・・識別力が小さので除外
・Q8とQ13・・・識別力が小さいが、正答率が比較的高いので「基礎知識の確認問題」として残すことも可能だが、基本的に除外

識別力が高すぎる項目の ICC

• 識別力が3.98 (Q30) と 2.66 (Q15) の ICC を確認する

library(irt)
library(ggplot2)
library(dplyr)

# 1. モデル推定（再掲）
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 2. パラメータ抽出（a=識別力, b=困難度）
param_df <- data.frame(
  Item = rownames(ex2$est),
  Discrimination = ex2$est[, 1],  # aパラメータ
  Difficulty = ex2$est[, 2]       # bパラメータ
)

# 3. 識別力が 0.2 以上の項目（＝Q30 & Q15）だけ抽出
low_disc_items <- param_df %>%
  filter(Discrimination > 2)  

# 4. θの範囲を設定
theta_vals <- seq(-4, 4, length.out = 200)

# 5. 各項目のICCを計算
icc_list <- lapply(1:nrow(low_disc_items), function(i) {
  a <- low_disc_items$Discrimination[i]
  b <- low_disc_items$Difficulty[i]
  item_name <- low_disc_items$Item[i]
  
  P <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLのICC公式
  data.frame(
    theta = theta_vals,
    Probability = P,
    Item = item_name
  )
})

# 6. データ結合
icc_long <- bind_rows(icc_list)

# 7. ラベル位置データ作成
label_positions <- icc_long %>%
  group_by(Item) %>%
  filter(theta == max(theta)) %>%  # θ = 4 の位置
  ungroup()

# 8. ICC描画
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1.2) +
  geom_text(
    data = label_positions,
    aes(label = Item),
    hjust = -0.1,
    vjust = 0,
    size = 3,
    show.legend = FALSE
  ) +
  scale_y_continuous(limits = c(0, 1)) +  # ★ ここでy軸を0〜1に固定 ★
  labs(
    title = "Q30 (識別力 = 3.98) とQ15（識別力 = 2.66）のICC",
    x = expression(theta),
    y = "正答確率"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme(legend.position = "none")  # 凡例を消してスッキリ

高すぎる識別力の問題点：

1. 現実を正しく反映していない可能性がある

• わずかな学力差（θの違い）で正答確率が極端に変化する
  → 「現実の受験行動」ではあまり起こらない
  → データのノイズ、サンプル数不足、異常応答などの影響を受けている可能性あり
  →　「統計的には識別力が高いけど、現実的には怪しい」

2. 異常値としてモデルの安定性を損なうリスクがある

• 極端に高い識別力項目は、モデル推定の不安定要因になる
  
• IRTでは、項目全体のバランスが大事
  
• 突出した項目があると、テスト全体の尺度（θ）推定が歪む可能性あり
  
• θ推定がその項目に引っ張られ、他の項目の情報が正しく活かされない

3. 実務的な理由

• 例えば受験者がほんの少し間違えただけで
  → θ（能力値）が過剰に低く評価されるリスクがある
  
• 逆にたまたま正答しただけで
  → θが過剰に高く評価されるリスクがある
  
• テスト結果の公平性・安定性を守るためには
  
• 異常に高い識別力の項目は除外または別扱い（参考扱い）にするのが一般的

識別力が高すぎる項目の評価
・識別力は、受験者のθ（能力）による正答確率の変化の鋭さを表す
・識別力が高いと　→　能力の違いに敏感に反応する
→　θが少し上がるだけで正答率が大きく上がる

識別力が2以上だと次にようなリスクがある

1. 現実を正しく反映できず
   
2. モデルの安定性を損ない
   
3. 受験者の能力を正しく評価できない

結論：

・Q30とQ15・・・識別力がマイナス（異常値）なので除外

適度な識別力項目 (0.3〜2.0) の ICC

library(irt)
library(ggplot2)
library(dplyr)

# 1. モデル推定（再掲）
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 2. パラメータ抽出（a=識別力, b=困難度）
param_df <- data.frame(
  Item = rownames(ex2$est),
  Discrimination = ex2$est[, 1],  # aパラメータ
  Difficulty = ex2$est[, 2]       # bパラメータ
)

# 3. 識別力が0.3以上、2.0以下の項目だけ抽出
low_disc_items <- param_df %>%
  filter(Discrimination > 0.3 & Discrimination < 2.0)

# 4. θの範囲を設定
theta_vals <- seq(-4, 4, length.out = 200)

# 5. 各項目のICCを計算
icc_list <- lapply(1:nrow(low_disc_items), function(i) {
  a <- low_disc_items$Discrimination[i]
  b <- low_disc_items$Difficulty[i]
  item_name <- low_disc_items$Item[i]
  
  P <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLのICC公式
  data.frame(
    theta = theta_vals,
    Probability = P,
    Item = item_name
  )
})

# 6. データ結合
icc_long <- bind_rows(icc_list)

# 7. ラベル位置データ作成
label_positions <- icc_long %>%
  group_by(Item) %>%
  filter(theta == max(theta)) %>%  # θ = 4 の位置
  ungroup()

# 8. ICC描画
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1.2) +
  geom_text(
    data = label_positions,
    aes(label = Item),
    hjust = -0.1,
    vjust = 0,
    size = 3,
    show.legend = FALSE
  ) +
  scale_y_continuous(limits = c(0, 1)) +  # ★ ここでy軸を0〜1に固定 ★
  labs(
    title = "適度な識別力項目 (0.3〜2.0) の ICC",
    x = expression(theta),
    y = "正答確率"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme(legend.position = "none")  # 凡例を消してスッキリ

識別力2.0以上の項目の評価

全体的な評価

・θ（学力）が上がるにつれて正答確率がきちんと上昇
・学力がやや低い付近（−2 〜 0）で、正答確率がぐっと上がる項目が多い
・θが低い受験者と高い受験者で正答率に差が出る
→ つまり、能力をよく区別できる優れた項目群

識別力	評価	詳細
1.0〜2.0	◎ 非常に良い	能力差を鋭く捉えられる（Q2, Q4, Q18, Q20）
0.6〜1.0	○ 良い	標準的な能力測定ができる（Q1, Q3, Q7, Q10, Q12）
0.3〜0.6	△ 許容範囲	使えるが改善を検討（Q5, Q6, Q14, Q19, Q32）

評価ごとのICC

識別力	評価	詳細
1.0〜2.0	◎ 非常に良い	能力差を鋭く捉えられる（例：Q2, Q4, Q18, Q20など）

library(irt)
library(ggplot2)
library(dplyr)

# 1. モデル推定（再掲）
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 2. パラメータ抽出（a=識別力, b=困難度）
param_df <- data.frame(
  Item = rownames(ex2$est),
  Discrimination = ex2$est[, 1],  # aパラメータ
  Difficulty = ex2$est[, 2]       # bパラメータ
)

# 3. Q1, Q3, Q7, Q10, Q12だけ抽出
low_disc_items <- param_df %>%
  filter(Item %in% c("Q2", "Q4", "Q18", "Q20"))

# 4. θの範囲を設定
theta_vals <- seq(-4, 4, length.out = 200)

# 5. 各項目のICCを計算
icc_list <- lapply(1:nrow(low_disc_items), function(i) {
  a <- low_disc_items$Discrimination[i]
  b <- low_disc_items$Difficulty[i]
  item_name <- low_disc_items$Item[i]
  
  P <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLのICC公式
  data.frame(
    theta = theta_vals,
    Probability = P,
    Item = item_name
  )
})

# 6. データ結合
icc_long <- bind_rows(icc_list)

# 7. ラベル位置データ作成
label_positions <- icc_long %>%
  group_by(Item) %>%
  filter(theta == max(theta)) %>%
  ungroup()

# 8. ICC描画
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1.2) +
  geom_text(
    data = label_positions,
    aes(label = Item),
    hjust = -0.1,
    vjust = 0,
    size = 3,
    show.legend = FALSE
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "指定項目 (Q2, Q4, Q18, Q20) の ICC",
    x = expression(theta),
    y = "正答確率"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme(legend.position = "none")

識別力	評価	詳細
0.6〜1.0	○ 良い	標準的な能力測定ができる（Q1, Q3, Q7, Q10, Q12）

library(irt)
library(ggplot2)
library(dplyr)

# 1. モデル推定（再掲）
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 2. パラメータ抽出（a=識別力, b=困難度）
param_df <- data.frame(
  Item = rownames(ex2$est),
  Discrimination = ex2$est[, 1],  # aパラメータ
  Difficulty = ex2$est[, 2]       # bパラメータ
)

# 3. Q1, Q3, Q7, Q10, Q12だけ抽出
low_disc_items <- param_df %>%
  filter(Item %in% c("Q1", "Q3", "Q7", "Q10", "Q12"))

# 4. θの範囲を設定
theta_vals <- seq(-4, 4, length.out = 200)

# 5. 各項目のICCを計算
icc_list <- lapply(1:nrow(low_disc_items), function(i) {
  a <- low_disc_items$Discrimination[i]
  b <- low_disc_items$Difficulty[i]
  item_name <- low_disc_items$Item[i]
  
  P <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLのICC公式
  data.frame(
    theta = theta_vals,
    Probability = P,
    Item = item_name
  )
})

# 6. データ結合
icc_long <- bind_rows(icc_list)

# 7. ラベル位置データ作成
label_positions <- icc_long %>%
  group_by(Item) %>%
  filter(theta == max(theta)) %>%
  ungroup()

# 8. ICC描画
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1.2) +
  geom_text(
    data = label_positions,
    aes(label = Item),
    hjust = -0.1,
    vjust = 0,
    size = 3,
    show.legend = FALSE
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "指定項目 (Q1, Q3, Q7, Q10, Q12) の ICC",
    x = expression(theta),
    y = "正答確率"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme(legend.position = "none")

識別力	評価	詳細
0.3〜0.6	△ 許容範囲	使えるが改善を検討（Q5, Q6, Q14, Q19, Q32）

library(irt)
library(ggplot2)
library(dplyr)

# 1. モデル推定（再掲）
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 2. パラメータ抽出（a=識別力, b=困難度）
param_df <- data.frame(
  Item = rownames(ex2$est),
  Discrimination = ex2$est[, 1],  # aパラメータ
  Difficulty = ex2$est[, 2]       # bパラメータ
)

# 3. Q5, Q6, Q14, Q19, Q32だけ抽出
low_disc_items <- param_df %>%
  filter(Item %in% c("Q5", "Q6", "Q14", "Q19", "Q32"))

# 4. θの範囲を設定
theta_vals <- seq(-4, 4, length.out = 200)

# 5. 各項目のICCを計算
icc_list <- lapply(1:nrow(low_disc_items), function(i) {
  a <- low_disc_items$Discrimination[i]
  b <- low_disc_items$Difficulty[i]
  item_name <- low_disc_items$Item[i]
  
  P <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLのICC公式
  data.frame(
    theta = theta_vals,
    Probability = P,
    Item = item_name
  )
})

# 6. データ結合
icc_long <- bind_rows(icc_list)

# 7. ラベル位置データ作成
label_positions <- icc_long %>%
  group_by(Item) %>%
  filter(theta == max(theta)) %>%
  ungroup()

# 8. ICC描画
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1.2) +
  geom_text(
    data = label_positions,
    aes(label = Item),
    hjust = -0.1,
    vjust = 0,
    size = 3,
    show.legend = FALSE
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "指定項目 (Q5, Q6, Q14, Q19, Q32) の ICC",
    x = expression(theta),
    y = "正答確率"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme(legend.position = "none")

困難度 b の解釈：

適切な困難力 b の大きさ

−3 〜 3

（出典：芝祐順編『項目反応理論』p.34）

• 困難度の値順に可視化する

library(irt)
library(ggplot2)
library(dplyr)

# 1. モデル推定
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 2. パラメータ抽出
difficulty_df <- data.frame(
  Item = rownames(ex2$est),
  Difficulty = ex2$est[, 2]
)

# 3. 困難度で並べ替え（昇順）
difficulty_df <- difficulty_df %>%
  arrange(Difficulty) %>%
  mutate(Item = factor(Item, levels = Item))  # 項目順を固定する

# 4. ラベル位置を調整（棒の先に表示するため）
difficulty_df <- difficulty_df %>%
  mutate(label_position = ifelse(Difficulty >= 0, Difficulty + 0.2, Difficulty - 0.2))

# 5. プロット
ggplot(difficulty_df, aes(x = Difficulty, y = Item)) +
  geom_bar(stat = "identity", aes(fill = Difficulty > 0), width = 0.6) +
  geom_text(aes(label = round(Difficulty, 2), x = label_position), 
            size = 3, hjust = ifelse(difficulty_df$Difficulty >= 0, 0, 1)) +
  # ★ ここで赤い点線を引く ★
  geom_vline(xintercept = c(-3, 3), color = "red", linetype = "dashed", size = 0.2) +
  scale_fill_manual(values = c("skyblue", "salmon"), guide = "none") +
  labs(
    title = "困難度（Difficulty）の分布（-3と3に赤い点線）",
    x = "困難度",
    y = "項目"
  ) +
  theme_minimal(base_family = "Hiragino Sans")

• Q25, Q28, Q11, Q34が難しすぎる問題（困難度 b が 3 以上)
  
• Q24, Q13, Q37, Q31が簡単すぎる問題（困難度 b が -3 以下)

難しすぎる問題 (Q25, Q28, Q11, Q34) の ICC

library(irt)
library(ggplot2)
library(dplyr)

# 1. モデル推定（再掲）
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 2. パラメータ抽出（識別力と困難度）
param_df <- data.frame(
  Item = rownames(ex2$est),
  Discrimination = ex2$est[, 1],  # 識別力 a
  Difficulty = ex2$est[, 2]       # 困難度 b
)

# 3. 必要な項目だけフィルター（Q25, Q28, Q11, Q34）
selected_items <- param_df %>%
  filter(Item %in% c("Q25", "Q28", "Q11", "Q34"))

# 4. θの範囲を設定
theta_vals <- seq(-4, 4, length.out = 200)

# 5. 各項目のICCを計算
icc_list <- lapply(1:nrow(selected_items), function(i) {
  a <- selected_items$Discrimination[i]
  b <- selected_items$Difficulty[i]
  item_name <- selected_items$Item[i]
  
  P <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLモデルのICC公式
  data.frame(
    theta = theta_vals,
    Probability = P,
    Item = item_name
  )
})

# 6. データをまとめる
icc_long <- bind_rows(icc_list)

# 7. ラベル位置データ作成（θ = 4のときに表示）
label_positions <- icc_long %>%
  group_by(Item) %>%
  filter(theta == max(theta)) %>%
  ungroup()

# 8. ICCプロット
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1.2) +
  geom_text(
    data = label_positions,
    aes(label = Item),
    hjust = -0.1,
    vjust = 0,
    size = 3,
    show.legend = FALSE
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "Q25, Q28, Q11, Q34 の ICC",
    x = expression(theta),
    y = "正答確率"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme(legend.position = "none")

• 特にQ25とQ28は問題が難し過ぎて、正答率が低い
  
• 識別力も低い

簡単過ぎる問題 (Q24, Q13, Q37, Q31) の ICC

library(irt)
library(ggplot2)
library(dplyr)

# 1. モデル推定（再掲）
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 2. パラメータ抽出（識別力と困難度）
param_df <- data.frame(
  Item = rownames(ex2$est),
  Discrimination = ex2$est[, 1],  # 識別力 a
  Difficulty = ex2$est[, 2]       # 困難度 b
)

# 3. 必要な項目だけフィルター（Q25, Q28, Q11, Q34）
selected_items <- param_df %>%
  filter(Item %in% c("Q24", "Q13", "Q37", "Q31"))

# 4. θの範囲を設定
theta_vals <- seq(-4, 4, length.out = 200)

# 5. 各項目のICCを計算
icc_list <- lapply(1:nrow(selected_items), function(i) {
  a <- selected_items$Discrimination[i]
  b <- selected_items$Difficulty[i]
  item_name <- selected_items$Item[i]
  
  P <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLモデルのICC公式
  data.frame(
    theta = theta_vals,
    Probability = P,
    Item = item_name
  )
})

# 6. データをまとめる
icc_long <- bind_rows(icc_list)

# 7. ラベル位置データ作成（θ = 4のときに表示）
label_positions <- icc_long %>%
  group_by(Item) %>%
  filter(theta == max(theta)) %>%
  ungroup()

# 8. ICCプロット
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1.2) +
  geom_text(
    data = label_positions,
    aes(label = Item),
    hjust = -0.1,
    vjust = 0,
    size = 3,
    show.legend = FALSE
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "Q24, Q13, Q37, Q31 の ICC",
    x = expression(theta),
    y = "正答確率"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme(legend.position = "none")

• Q24の困難度・・・-19.87（異常値）
  
• Q13は能力が最低の受験生でも約50％の正答率
  →　能力が平均の受験生（θ= 0）だと60%
  
• Q37の正答率・・・96%
  
• Q31の正答率・・・94%

標準誤差（識別力）の解釈：

標準誤差（識別力）の範囲

0.1 〜 0.4（識別力 a の標準誤差）

（出典：芝祐順編『項目反応理論』p.34）

library(irt)
library(ggplot2)
library(dplyr)

# モデル推定
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 困難度の標準誤差（標準偏差）を取り出す
disc_se <- ex2$se[, 2]  # 2列目が困難度SE

# 本来の項目番号リスト（Q1〜Q40からQ21, Q27, Q36, Q40を除いたもの）
item_names <- c(
  paste0("Q", 1:20), 
  paste0("Q", 22:26), 
  paste0("Q", 28:35), 
  paste0("Q", 37:39)
)

# データフレームに変換して、小さい順に並べ替え
disc_se_df <- data.frame(
  Item = item_names,
  Difficulty_SE = disc_se
) %>%
  arrange(Difficulty_SE) %>%
  mutate(Item = factor(Item, levels = Item))  # 並び順を反映

# ラベルを棒グラフより少し右にずらすためオフセット作成
disc_se_df <- disc_se_df %>%
  mutate(label_position = Difficulty_SE + 0.02)

# グラフ描画
ggplot(disc_se_df, aes(x = Difficulty_SE, y = Item)) +
  geom_bar(stat = "identity", fill = "darkgreen") +
  geom_text(aes(x = label_position, label = round(Difficulty_SE, 3)), 
            hjust = 0, size = 4) +  # hjust=0で左寄せ
  geom_vline(xintercept = c(0.2, 0.5), color = "red", linetype = "dashed", size = 0.4) +
  labs(
    title = "困難度の標準誤差（SE）の値順に並べた項目", 
    x = "困難度の標準誤差", 
    y = "項目"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme_bw(base_family = "HiraKakuProN-W3")

#### 標準誤差（困難度）の結果

標準誤差の規模	項目例	評価
小さい（安定）	Q8, Q5, Q13, Q34など	安心して使える
中程度（許容範囲）	Q2, Q3, Q39など	普通。使えるが特別良いわけではない
大きい（不安定）	Q30, Q15, Q29, Q37, Q20, Q31	注意。改善または除外を検討

標準誤差（困難度）の解釈：

標準誤差（困難度）の範囲

0.2 〜 0.5（困難度 b の標準誤差）

（出典：芝祐順編『項目反応理論』p.34）

library(irt)
library(ggplot2)
library(dplyr)

# モデル推定
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 困難度の標準誤差（標準偏差）を取り出す
disc_se <- ex2$se[, 2]  # 1列目が困難度の標準誤差

# 項目名を取得
item_names <- rownames(ex2$est)

# データフレームに変換して、小さい順に並べ替え
disc_se_df <- data.frame(
  Item = item_names,
  Discrimination_SE = disc_se
) %>%
  arrange(Discrimination_SE) %>%
  mutate(Item = factor(Item, levels = Item))  # 並び順をグラフに反映

# ★ ラベルを棒グラフより少し右にずらすためにオフセットを作成
disc_se_df <- disc_se_df %>%
  mutate(label_position = Discrimination_SE + 0.02)  # 0.02だけ右にずらす

# グラフ描画（横向き棒グラフ：左小 → 右大）
ggplot(disc_se_df, aes(x = Discrimination_SE, y = Item)) +
  geom_bar(stat = "identity", fill = "darkgreen") +
  geom_text(aes(x = label_position, label = round(Discrimination_SE, 3)), 
            hjust = 0, size = 4) +  # ★hjust=0で左寄せ
  # ★ ここで赤い点線を引く ★
  geom_vline(xintercept = c(0.2, 0.5), color = "red", linetype = "dashed", size = 0.4) +
  labs(
    title = "困難度の標準誤差（SE）の値順に並べた項目", 
    x = "困難度の標準誤差", 
    y = "項目"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme_bw(base_family = "HiraKakuProN-W3")  # 文字化け対策

• Q25の標準誤差 = 197
  
• Q28の標準誤差 = 134.407

なぜこんな異常が出るか？

• その項目がほぼ全員正答 or 誤答
  

• サンプルサイズが少ない
  

• 受験者の能力分布と項目難易度がずれている

• Q25の正答率・・・21%
  

• Q28の正答率・・・33%

• Q28, Q28, Q24, QQ13, Q11, Q34 を除いて、可視化してみる

library(irt)
library(ggplot2)
library(dplyr)

# モデル推定
ex2 <- est(resp = df2[, 2:37], 
           model = "2PL",        
           engine = "ltm")

# 困難度の標準誤差（標準偏差）を取り出す
disc_se <- ex2$se[, 2]  # 2列目が困難度の標準誤差

# 項目名を取得
item_names <- rownames(ex2$est)

# データフレームに変換して、小さい順に並べ替え
disc_se_df <- data.frame(
  Item = item_names,
  Discrimination_SE = disc_se
) %>%
  filter(!(Item %in% c("Q25", "Q28", "Q24", "Q13", "Q11", "Q34"))) %>%   # ★ここで除外
  arrange(Discrimination_SE) %>%
  mutate(Item = factor(Item, levels = Item))        # 並び順をグラフに反映

# ラベルを棒グラフより少し右にずらすためにオフセットを作成
disc_se_df <- disc_se_df %>%
  mutate(label_position = Discrimination_SE + 0.02)

# グラフ描画（横向き棒グラフ：左小 → 右大）
ggplot(disc_se_df, aes(x = Discrimination_SE, y = Item)) +
  geom_bar(stat = "identity", fill = "darkgreen") +
  geom_text(aes(x = label_position, label = round(Discrimination_SE, 3)), 
            hjust = 0, size = 4) +
  geom_vline(xintercept = c(0.2, 0.5), color = "red", linetype = "dashed", size = 0.4) +
  labs(
    title = "困難度の標準誤差の値順に並べた項目（Q28, Q28, Q24, Q13, Q11, Q34を除外）", 
    x = "困難度の標準誤差", 
    y = "項目"
  ) +
  theme_minimal(base_family = "Hiragino Sans") +
  theme_bw(base_family = "HiraKakuProN-W3")

標準誤差（困難度）の結果

標準誤差の規模	項目例	評価
小さい（安定）	Q20, Q4, Q9, Q10など	安心して使える
中程度（許容範囲）		普通。使えるが特別良いわけではない
大きい（不安定）	Q25, Q28, Q24, Q37など	注意。改善または除外を検討

• 困難度（難易度）の標準誤差（SE）が大きいということは・・・
  ▶ その項目の困難度の推定が不安定である

標準誤差が大きいと次のような問題が起こる

1. 困難度の推定値が信頼できない

• 例えば、困難度 = -1.2 と推定されても
  
• 標準誤差が大きいと「本当は-1.8かもしれないし、-0.6かもしれない」とブレる
  
• 困難度がはっきりしない項目は、受験者の能力を正確に測る力が弱い

2. テスト全体の信頼性が下がる

• ブレブレの項目がテストに多いと
  →　テスト全体で測っている学力θの精度も落ちる

3. IRTモデルのフィット（適合度）が悪くなる

• 困難度が不安定な項目が多いと、モデル全体にとっても悪影響
  
• 項目反応曲線（ICC）がきれいな S 字ではなく変な形になる

7.6 分析結果（理想的な基準）

• 項目パラメタにそれぞれ適切な値を適応して項目の採用・不採用を検討する

適切な識別力、困難度、標準誤差
0.3 〜 2.0（識別力）
−3 〜 3（困難度）
0.1 〜 0.4（識別力 a の標準誤差）
0.2 〜 0.5（困難度 b の標準誤差）
（出典：芝祐順編『項目反応理論』p.34）

library(dplyr)

# 項目番号と列番号の設定
item_names <- c(
  paste0("Q", 1:20),  # Q1〜Q20では削除項目なし
  paste0("Q", 22:26), # Q21とQ27を削除　→　Q22〜Q26は修正不要
  paste0("Q", 28:35), # Q27とQ36を削除　→　Q28〜Q35は修正不要
  paste0("Q", 37:39)  # Q40を削除　→　Q40は含めない
)
column_numbers <- c(
  1:20,
  22:26,
  28:35,
  37:39
)

# --- estとseを読み込み（推定済みex2を使用）---
est <- ex2$est
se <- ex2$se

# --- データフレーム作成（列番号付き）---
irt_result <- data.frame(
  Col_No = 1:length(item_names),  # 列番号
  Item = item_names,              # 項目番号
  a = est[, 1],                # 識別力
  b = est[, 2],                # 困難度
  SE_a = se[, 1],              # 識別力の標準誤差
  SE_b = se[, 2]               # 困難度の標準誤差
)

# --- 判断と理由を付与 ---
irt_result <- irt_result %>%
  mutate(
    # 判断
    Judgment = case_when(
      a < 0.3 | a > 2 |
      b < -3 | b > 3 |
      SE_a < 0.1 | SE_a > 0.4 |
      SE_b < 0.2 | SE_b > 0.5 ~ "検討or削除",
      TRUE ~ "問題ない"
    ),
    
    # 理由
    Reason = case_when(
      a < 0.3 ~ "aが低",
      a > 2 ~ "aが高",
      b < -3 ~ "bが低",
      b > 3 ~ "bが高",
      SE_a < 0.1 ~ "SE_aが小",
      SE_a > 0.4 ~ "SE_aが大",
      SE_b < 0.2 ~ "SE_bが小",
      SE_b > 0.5 ~ "SE_bが大",
      TRUE ~ ""
    )
  ) %>%
  mutate(
    a = round(a, 3),
    b = round(b, 3),
    SE_a = round(SE_a, 3),
    SE_b = round(SE_b, 3)
  ) %>%
  arrange(factor(Judgment, levels = c("検討or削除", "問題ない")))

DT::datatable(irt_result)

• 「問題ない」・・・13項目
  
• 「検討or削除」・・・23項目

理想的な基準評価が「問題ない」13項目だけの ICC

library(ltm)  # IRTモデル推定用パッケージ

# 1. 問題ない項目だけ選択
items_ok <- irt_result %>%
  filter(Judgment == "問題ない") %>%
  pull(Item)  # Item名だけ取り出す

# 2. 元データから該当項目だけ抜き出し
# ※ここで元データ（ex2推定時に使ったデータフレーム）が必要です
# 例）df2とする（あなたの環境に合わせて読み替えてね）
df2_selected <- df2[, items_ok]

# 3. 問題ない項目だけでIRT再推定（2PLモデル）
mod_ok <- ltm(df2_selected ~ z1, IRT.param = TRUE)

# 4. ICCを描画
plot(mod_ok, legend = TRUE, cex = 0.6)

• ここに表示された13項目は条件をすべてクリアーた「問題なし」の項目

理想的な基準評価が「検討or削除」23項目だけの ICC

library(ltm)  # IRTモデル推定用パッケージ

# 1. 問題ない項目だけ選択
items_ok <- irt_result %>%
  filter(Judgment == "検討or削除") %>%
  pull(Item)  # Item名だけ取り出す

# 2. 元データから該当項目だけ抜き出し
# ※ここで元データ（ex2推定時に使ったデータフレーム）が必要です
# 例）df2とする（あなたの環境に合わせて読み替えてね）
df2_selected <- df2[, items_ok]

# 3. 問題ない項目だけでIRT再推定（2PLモデル）
mod_ok <- ltm(df2_selected ~ z1, IRT.param = TRUE)

# 4. ICCを描画
plot(mod_ok, legend = TRUE, cex = 0.6)

• ここに表示された23項目は何からの問題を抱えた「検討or削除」の項目
  
• 「検討or削除」の項目をさらに「検討」「削除すべき」に再分類する

7.7 分析結果（識別力を重視した基準）

基準値を緩める

• もしこの試験で最も重視したいのが「識別力」なら
  →　識別力だけを基準にして、「検討」「削除すべき」に再分類する

・項目が能力をどれだけ区別できるかを示すパラメータ

適切な識別力 a の大きさ

0.3 〜 2.0

（出典：芝祐順編『項目反応理論』p.34）

判断	基準（識別力）	説明
削除すべき	a ≤ 0.3 or a ≥ 2.5	情報なし or 特定範囲だけ超鋭敏すぎ
検討	0.3 < a < 0.6 or2.0 ≤ a < 2.5	即削除ではない
問題なし	0.6 ≤ a < 2.0	十分な情報を提供する標準的な範囲

library(dplyr)

# --- 項目リストと識別力読み込み ---
item_names <- c(
  paste0("Q", 1:20),
  paste0("Q", 22:26),
  paste0("Q", 28:35),
  paste0("Q", 37:39)
)

est <- ex2$est

# --- データフレーム作成（識別力だけ使う） ---
irt_result <- data.frame(
  Row_No = 1:length(item_names),
  Item = item_names,
  Disc = est[, 1]
)

# --- Judgment（識別力だけで判断） ---
irt_result <- irt_result %>%
  mutate(
    Judgment = case_when(
      Disc <= 0.3 | Disc >= 2.5 ~ "削除すべき",
      (Disc > 0.3 & Disc < 0.6) | (Disc >= 2.0 & Disc < 2.5) ~ "検討",
      Disc >= 0.6 & Disc < 2.0 ~ "問題なし",
      TRUE ~ NA_character_  # 念のため（どれにも該当しないケース）
    )
  ) %>%
  mutate(
    Disc = round(Disc, 3)  # 小数第3位に丸め
  ) %>%
  arrange(factor(Judgment, levels = c("削除すべき", "検討", "問題なし")))

DT::datatable(irt_result)

• 「問題なし」・・・22項目
  
• 「検討すべき」・・・4項目
  
• 「削除すべき」・・・10項目

「識別力」で「問題なし」22項目の ICC曲線

library(dplyr)
library(ggplot2)
library(tidyr)

# --- 項目リストとパラメータ読み込み ---
item_names <- c(
  paste0("Q", 1:20),
  paste0("Q", 22:26),
  paste0("Q", 28:35),
  paste0("Q", 37:39)
)

est <- ex2$est  # ex2は2PL推定済みモデルとします

# --- 識別力だけで最初フィルタリング ---
irt_result <- data.frame(
  Row_No = 1:length(item_names),
  Item = item_names,
  Disc = est[, 1],
  Diff = est[, 2]   # 困難度もここで持ってくる
)

# --- Judgment付与 ---
irt_result <- irt_result %>%
  mutate(
    Judgment = case_when(
      Disc <= 0.3 | Disc >= 2.5 ~ "削除すべき",
      (Disc > 0.3 & Disc < 0.6) | (Disc >= 2.0 & Disc < 2.5) ~ "検討",
      Disc >= 0.6 & Disc < 2.0 ~ "問題なし",
      TRUE ~ NA_character_
    )
  ) %>%
  mutate(
    Disc = round(Disc, 3),
    Diff = round(Diff, 3)
  ) %>%
  arrange(factor(Judgment, levels = c("削除すべき", "検討", "問題なし")))

# --- 1. 削除すべき項目だけ選ぶ ---
items_to_plot <- irt_result %>%
  filter(Judgment == "問題なし")

# --- 2. θの範囲設定 ---
theta_vals <- seq(-4, 4, length.out = 100)

# --- 3. 各項目ごとにICCを計算 ---
icc_list <- lapply(1:nrow(items_to_plot), function(i) {
  a <- items_to_plot$Disc[i]  # 識別力
  b <- items_to_plot$Diff[i]  # 困難度
  P_theta <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLモデル式
  data.frame(
    theta = theta_vals,
    Probability = P_theta,
    Item = items_to_plot$Item[i]
  )
})

# --- 4. データ結合 ---
icc_long <- bind_rows(icc_list)

# --- 5. ggplotでICC曲線を描画 ---
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1) +
  labs(
    title = "問題なし項目のICC曲線",
    x = "θ（能力値）",
    y = "正答確率"
  ) +
  theme_minimal() +
  theme(
  text = element_text(family = "Hiragino Sans")  # or "Hiragino Kaku Gothic ProN"
)

「識別力」で「検討」4項目の ICC曲線

library(dplyr)
library(ggplot2)
library(tidyr)

# --- 項目リストとパラメータ読み込み ---
item_names <- c(
  paste0("Q", 1:20),
  paste0("Q", 22:26),
  paste0("Q", 28:35),
  paste0("Q", 37:39)
)

est <- ex2$est  # ex2は2PL推定済みモデルとします

# --- 識別力だけで最初フィルタリング ---
irt_result <- data.frame(
  Row_No = 1:length(item_names),
  Item = item_names,
  Disc = est[, 1],
  Diff = est[, 2]   # 困難度もここで持ってくる
)

# --- Judgment付与 ---
irt_result <- irt_result %>%
  mutate(
    Judgment = case_when(
      Disc <= 0.3 | Disc >= 2.5 ~ "削除すべき",
      (Disc > 0.3 & Disc < 0.6) | (Disc >= 2.0 & Disc < 2.5) ~ "検討",
      Disc >= 0.6 & Disc < 2.0 ~ "問題なし",
      TRUE ~ NA_character_
    )
  ) %>%
  mutate(
    Disc = round(Disc, 3),
    Diff = round(Diff, 3)
  ) %>%
  arrange(factor(Judgment, levels = c("削除すべき", "検討", "問題なし")))

# --- 1. 削除すべき項目だけ選ぶ ---
items_to_plot <- irt_result %>%
  filter(Judgment == "検討")

# --- 2. θの範囲設定 ---
theta_vals <- seq(-4, 4, length.out = 100)

# --- 3. 各項目ごとにICCを計算 ---
icc_list <- lapply(1:nrow(items_to_plot), function(i) {
  a <- items_to_plot$Disc[i]  # 識別力
  b <- items_to_plot$Diff[i]  # 困難度
  P_theta <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLモデル式
  data.frame(
    theta = theta_vals,
    Probability = P_theta,
    Item = items_to_plot$Item[i]
  )
})

# --- 4. データ結合 ---
icc_long <- bind_rows(icc_list)

# --- 5. ggplotでICC曲線を描画 ---
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1) +
  ylim(0, 1) +
  labs(
    title = "検討項目のICC曲線",
    x = "θ（能力値）",
    y = "正答確率"
  ) +
  theme_minimal() +
  theme(
  text = element_text(family = "Hiragino Sans")  # or "Hiragino Kaku Gothic ProN"
)

「識別力」で「削除すべき」10項目の ICC曲線

library(dplyr)
library(ggplot2)
library(tidyr)

# --- 項目リストとパラメータ読み込み ---
item_names <- c(
  paste0("Q", 1:20),
  paste0("Q", 22:26),
  paste0("Q", 28:35),
  paste0("Q", 37:39)
)

est <- ex2$est  # ex2は2PL推定済みモデルとします

# --- 識別力だけで最初フィルタリング ---
irt_result <- data.frame(
  Row_No = 1:length(item_names),
  Item = item_names,
  Disc = est[, 1],
  Diff = est[, 2]   # 困難度もここで持ってくる
)

# --- Judgment付与 ---
irt_result <- irt_result %>%
  mutate(
    Judgment = case_when(
      Disc <= 0.3 | Disc >= 2.5 ~ "削除すべき",
      (Disc > 0.3 & Disc < 0.6) | (Disc >= 2.0 & Disc < 2.5) ~ "検討",
      Disc >= 0.6 & Disc < 2.0 ~ "問題なし",
      TRUE ~ NA_character_
    )
  ) %>%
  mutate(
    Disc = round(Disc, 3),
    Diff = round(Diff, 3)
  ) %>%
  arrange(factor(Judgment, levels = c("削除すべき", "検討", "問題なし")))

# --- 1. 削除すべき項目だけ選ぶ ---
items_to_plot <- irt_result %>%
  filter(Judgment == "削除すべき")

# --- 2. θの範囲設定 ---
theta_vals <- seq(-4, 4, length.out = 100)

# --- 3. 各項目ごとにICCを計算 ---
icc_list <- lapply(1:nrow(items_to_plot), function(i) {
  a <- items_to_plot$Disc[i]  # 識別力
  b <- items_to_plot$Diff[i]  # 困難度
  P_theta <- 1 / (1 + exp(-a * (theta_vals - b)))  # 2PLモデル式
  data.frame(
    theta = theta_vals,
    Probability = P_theta,
    Item = items_to_plot$Item[i]
  )
})

# --- 4. データ結合 ---
icc_long <- bind_rows(icc_list)

# --- 5. ggplotでICC曲線を描画 ---
ggplot(icc_long, aes(x = theta, y = Probability, color = Item)) +
  geom_line(size = 1) +
  labs(
    title = "削除すべき項目のICC曲線",
    x = "θ（能力値）",
    y = "正答確率"
  ) +
  theme_minimal() +
  theme(
  text = element_text(family = "Hiragino Sans")  # or "Hiragino Kaku Gothic ProN"
)

References

• Lord, F. M. (1952). A theory of test scores. Psychometric Monograph.
  
• 教育心理学会チュートリアル2018資料
  
• 項目反応理論(IRT)の考え方と実践(2019)
  
• 芝祐順編 (1991)『項目反応理論: 基礎と応用』、東京大学出版会