統計解析ソフトＲのスクリプト集[Ver.15.0]

本冊子では，データファイルとして CSV (コンマ区切り)(*.csv) で保存した Shift JIS コードのcsvファイルを用いることを前提としており，read.table や write.table において，fileEncoding ="shift-jis" オプションを付けています。 UTF-8 CSV ファイルを用いる場合は，このオプションを削除してください。

2024年4月
名古屋大学

大学院教育発達科学研究科・教育学部

心理発達科学専攻

計量心理学領域

石井研究室

名古屋大学

大学院教育発達科学研究科・教育学部

はじめに
この冊子は，心理学や教育学の研究でよく用いられる統計手法に関して，統計解析ソフト「Ｒ」のスクリプト（プログラム）をまとめたもので，授業の補助教材として作成されたものです．
Ｒは，スクリプトと言われるプログラムを書いてそれを実行する，という使い方をします．例えば，クロス表を表示するとしたら，スクリプト画面に table(d1$x1, d1$x2) と書き，この部分を選択して実行します．
すると，出力画面に，実行したスクリプトとその結果が表示されます．
ここで，table がゴシック体になっていますが，これは，table がＲの関数であることを表しています．
スクリプト画面上でこのような表示がされるわけではありません．この冊子においては，Ｒの関数とそうでないもの（分析者が指定する変数名など）を区別するために，このような表示をしています．
本冊子では，重要と思われるコメントもゴシック体にしてあります．これは基本的に和文で，「#」を前に書いてコメントアウトしてあるので（Ｒは認識しない），それがＲの関数でないことはすぐわかると思います．
正しいスクリプトでないとソフトは動かず，エラーとなります．正しいスクリプトを書いて結果が表示されると，とても嬉しい気持ちになります．また，スクリプトを書くのに慣れてくるにつれ，分析法を考える力が増し，統計分析力が向上します．
本冊子はＲの実行に主眼を置いているため，分析結果をどのように解釈するかについてはほとんど触れていません．統計分析の手法や結果の解釈については，別の成書にあたって下さい．参考までに，本冊子と関連の強い書籍を挙げておきます．１冊目には，本スクリプト集と同じデータを用いた分析例が出てきます．
人間科学のための統計分析―こころに関心があるすべての人のために―
http://www.amazon.co.jp/dp/4263731611/

医歯薬出版

統計分析のここが知りたい―保健・看護・心理・教育系研究のまとめ方―
http://www.amazon.co.jp/dp/4830644605/

文光堂

2014
2005

Essentials of Statistical Analysis and Psychometrics in Human Sciences.
See Sein Publishing:Myanmar, 2019 「人間科学のための統計分析」の英語版）
公認心理師カリキュラム準拠 臨床統計学 [心理学統計法・心理学研究法]
https://www.amazon.co.jp/dp/4263266358/

医歯薬出版

2020

Ｒは開発環境が公開されているため，多くの研究者がボランティアで開発に関わっている，世界的に定評のあるフリーソフトです．新しい統計手法がすぐに取り入れられるという利点はありますが，同じ分析をするのでも開発者が複数いて，多数の関数が存在することがあったり，古い関数が使えなくなったりするという欠点もあります．ユーザー自身が使いやすい関数を選び，時折，知識を更新する必要があります．
Ｒは日々開発されていますので，この冊子の内容もすぐに古いものになってしまいます．ですので，こんな関数があるとか，ここの記述は間違ってる，これはもう使えないなど，気づいたことがありましたら，教えて頂ければ幸いです．
問い合わせ先（(ａ)を@に変えて下さい）
ishii.lab.nuedu.psychometrics(ａ)gmail.com
石井研究室Webサイト
http://www.educa.nagoya-u.ac.jp/~ishii-h/
石井 秀宗
2名古屋大学

大学院教育発達科学研究科・教育学部

目次

はじめに ……………………………………………………………………………………………………………… 2

１

Ｒを使うためにＲの概要 ……………………………………………………………………………………………………………… 9
Ｒを使うための準備 …………………………………………………………………………………………………10
管理者権限について ………………………………………………………………………………………………… 11
Ｒのインストール …………………………………………………………………………………………………… 13
Ｒの起動と終了 ……………………………………………………………………………………………………… 17
パッケージのインストール ………………………………………………………………………………………… 18
パッケージの読み込み・取り外し ………………………………………………………………………………… 19
スクリプトの新規作成・保存・読み込み ………………………………………………………………………… 20
スクリプトの実行 …………………………………………………………………………………………………… 22
オブジェクトの確認・消去 ………………………………………………………………………………………… 23
ヘルプの使い方 ……………………………………………………………………………………………………… 24
スクリプトの外部ファイルへのコピー …………………………………………………………………………… 25
出力結果の外部保存 － Wordファイルなどに保存 …………………………………………………………… 26
出力結果の外部保存 － sink関数 ……………………………………………………………………………… 27
図の外部保存 － Wordファイルなどに貼りつけ ……………………………………………………………… 29
図の外部保存 － PDFファイルに保存 …………………………………………………………………………… 30
出力結果をExcelで整形保存 ……………………………………………………………………………………… 31
Ｒの情報源 …………………………………………………………………………………………………………… 34
Mac版のＲで作業ディレクトリを設定 …………………………………………………………………………… 35
Mac版のＲでread.table関数でCSVファイルを読み込み ………………………………………………………… 37
Mac版のＲで図を描いたときに日本語を正しく表示させる …………………………………………………… 38
R Studioについて …………………………………………………………………………………………………… 39
Google Colaboratory で R を使うための準備 ………………………………………………………………… 41
Google Colaboratory で R を使う ……………………………………………………………………………… 44
Google Colaboratory にCSVデータをアップロードする ……………………………………………………… 45
Google Colaboratory に日本語フォントをインストールする ………………………………………………… 46
Google Colaboratory のノートブックを保存する ……………………………………………………………… 47
Google Colaboratory のノートブックを共有する ……………………………………………………………… 48

２

Ｒのスクリプト作成時の注意点とエラーへの対処

スクリプト作成にあたっての一般的注意 ………………………………………………………………………… 49
スクリプトの冒頭に作業メモリを空にするコマンドを書く
バックスラッシュと円マーク
コメントを書くときは # を使う
半角ｶﾅ文字を使わない
全角文字もなるべく使わない
スクリプトの各行の先頭に「>」「+」「1:」などを書かない
データファイルの変数名とRスクリプトの変数名を一致させる
Rの予約語をオブジェクト名に用いない
pi，T，Fなどをオブジェクト名に用いない代入結果を表示するときは当該のスクリプト部分を () で囲う
改行の位置に気をつける
欠測のあるデータの分析について四捨五入について作成したスクリプトを少しずつ実行して確認する
よくある質問・エラー ……………………………………………………………………………………………… 55
データが読み込めない（rm, setwd, read.table）
添え字が許される範囲外です と表示される
作成した覚えのない変数が存在する
incomplete final line found by readTableHeader と表示される結果の数値に e-01 のような表記が付く
パッケージが開けないパッケージの関数が使えない
エラーが発生したときの対処 ……………………………………………………………………………………… 58
半角ｶﾅ文字を使っていませんか？
お使いのPCのOSは何ですか？
Excelでデータを保存したCSVデータと，Rでの読み込み形式は合っていますか？
作業メモリ上に余計なデータが保存されていませんか？
3名古屋大学

大学院教育発達科学研究科・教育学部

実行するスクリプトの範囲選択は正しいですか？
データのあるフォルダを正しく設定していますか？
データファイル名は正しいですか？
変数名を間違えていませんか？
データファイルの変数名にスペースが入っていませんか？
全角記号が混ざっていませんか？
スペルミスをしていませんか？
スクリプトを書くときに「>」「+」「1:」などを左端に書いていませんか？
大文字と小文字を間違えていませんか？
記号を間違えていませんか？
カンマを忘れていませんか？
カンマを多く入れていませんか？
カンマとピリオドを間違えていませんか？
文字列をダブルクォーテーションで囲うのを忘れていませんか？
カッコをつけ忘れていませんか？
カッコの種類を間違えていませんか？
カッコで括らなければならないのを忘れていませんか？
カッコをつける位置を間違えていませんか？
オプションは正しく書かれていますか？
if - else文を書くとき，if 文の終わりと else 文の始まりの間で改行してませんか？
１行に複数の命令文を書いていませんか？
１つの数式を複数行に分けて書くとき，次の行の先頭が+ - * / などの記号になっていませんか？
パッケージは正しくインストールされていますか？
R Studioを使っていませんか？
Rが複数個，起動していませんか？
コンピュータが再起動待ちの状態になっていませんか？
全角文字を使っていることが原因のこともあります
パソコンのユーザー名が全角文字になっていることが原因のこともあります
Rやコンピュータを再起動することも有効です
Rを再インストールすることも有効です３

データの作成・読み込み・保存

Excelにおけるデータファイルの作成 …………………………………………………………………………… 64
Excelを使わずにCSVファイルを作成 ……………………………………………………………………………… 65
ExcelにおけるデータファイルのCSV保存 ………………………………………………………………………… 66
作業ディレクトリの指定 …………………………………………………………………………………………… 67
データの読み込み …………………………………………………………………………………………………… 68
読み込んだデータの確認 …………………………………………………………………………………………… 70
Ｒ上のデータのCSV保存 …………………………………………………………………………………………… 71
UTF-8 CSVファイルをExelで読み込む方法 ……………………………………………………………………… 73
Excelデータファイルの読み込み・保存 ………………………………………………………………………… 74

４

データ操作

欠測値の取り扱い …………………………………………………………………………………………………… 77
データ値に基づいたカテゴリ変数の生成 ― 離散データ ……………………………………………………… 81
データ値に基づいたカテゴリ変数の生成 ― 連続データ ……………………………………………………… 82
カテゴリ変数の再カテゴリ化 ― 水準の合併 …………………………………………………………………… 83
不要な水準の削除・必要な水準の追加 …………………………………………………………………………… 84
回答データの採点 …………………………………………………………………………………………………… 85
逆転項目のデータ処理 ……………………………………………………………………………………………… 87
尺度得点の計算 ……………………………………………………………………………………………………… 88
データの標準化・中心化・偏差値化 ……………………………………………………………………………… 89
行名・列名（変数名）・要素名の指定 …………………………………………………………………………… 91
行や列の抽出・削除 ………………………………………………………………………………………………… 93
データの並べ替え …………………………………………………………………………………………………… 96
データの結合 ………………………………………………………………………………………………………… 97
対応のあるデータ（縦断的データ）のフォーマット変換 － Long Format and Wide Format…………… 100
データ型の確認・変換 …………………………………………………………………………………………… 104
データ構造の確認・変換 ………………………………………………………………………………………… 105
文字型の数字を数値型の数値に変換 …………………………………………………………………………… 106
factor型のデータ値の扱い ……………………………………………………………………………………… 108

５

統計図表

度数分布表 ………………………………………………………………………………………………………… 110
クロス集計表 ……………………………………………………………………………………………………… 111
4

名古屋大学

大学院教育発達科学研究科・教育学部

割合なども入ったクロス集計表 ………………………………………………………………………………… 113
群別のクロス集計表 ……………………………………………………………………………………………… 116
フラットなクロス集計表 ………………………………………………………………………………………… 1117
フラットなクロス集計表から通常のクロス集計表を作成 …………………………………………………… 120
円グラフ …………………………………………………………………………………………………………… 122
帯グラフ …………………………………………………………………………………………………………… 123
棒グラフ …………………………………………………………………………………………………………… 126
ヒストグラム ……………………………………………………………………………………………………… 129
２群の積み上げヒストグラム …………………………………………………………………………………… 131
箱ひげ図 …………………………………………………………………………………………………………… 132
折れ線グラフ ……………………………………………………………………………………………………… 133
散布図 ……………………………………………………………………………………………………………… 134
ひまわり図 ………………………………………………………………………………………………………… 135
バブルプロット …………………………………………………………………………………………………… 136
ラベルつき散布図 ………………………………………………………………………………………………… 137
グラフオプション ………………………………………………………………………………………………… 138
ggplotを使った作図 ……………………………………………………………………………………………… 141
度数を比較する棒グラフ ― ggplot …………………………………………………………………………… 143
平均値を比較する棒グラフ ― ggplot ………………………………………………………………………… 144
帯グラフ ― ggplot ……………………………………………………………………………………………… 145
ヒストグラム ― ggplot ………………………………………………………………………………………… 146
箱ひげ図 ― ggplot ……………………………………………………………………………………………… 147
折れ線グラフ ― ggplot ………………………………………………………………………………………… 148
散布図 ― ggplot ………………………………………………………………………………………………… 149６

量的変数の記述統計量

平均，標準偏差，最大値，中央値，最小値，分位数 ………………………………………………………… 150
群別の平均，標準偏差，最大値，中央値，最小値，分位数 ………………………………………………… 151
要約統計量 ― describe, describeBy ………………………………………………………………………… 153
２要因以上の群別要約統計量 …………………………………………………………………………………… 155
共分散・相関係数 ………………………………………………………………………………………………… 156
群別の共分散・相関係数 ………………………………………………………………………………………… 157
偏相関係数 ………………………………………………………………………………………………………… 159
四分相関係数・多分相関係数 …………………………………………………………………………………… 161
アルファ係数 ……………………………………………………………………………………………………… 163
オメガ係数 ………………………………………………………………………………………………………… 165
級内相関係数 ……………………………………………………………………………………………………… 166

７

１群または２群の平均値に関する推測 ― ｔ検定

１群の平均値の推測 ……………………………………………………………………………………………… 167
対応のある２群の平均値の比較 ………………………………………………………………………………… 168
対応のある２群の平均値差の効果量の推定 …………………………………………………………………… 169
対応のない２群の平均値の比較 ― 素データ ………………………………………………………………… 170
対応のない２群の平均値の比較 ― 要約統計量 ……………………………………………………………… 171
対応のない２群の平均値差の効果量の推定 …………………………………………………………………… 172
平均値の非劣性・同等性の検証 ― 素データ ………………………………………………………………… 175
平均値の非劣性・同等性の検証 ― 要約統計量 ……………………………………………………………… 177

８

分散に関する推測

２群の分散の比較 ― 素データ ………………………………………………………………………………… 178
２群の分散の比較 ― 要約統計量 ……………………………………………………………………………… 179
多群の分散の比較 ― 素データ ………………………………………………………………………………… 180
多群の分散の比較 ― 要約統計量 ……………………………………………………………………………… 181９多群の平均値に関する推測 ― 分散分析・多重比較

１つの被験者間要因(１Ｂ) ……………………………………………………………………………………… 182
１つの被験者内要因(１Ｗ) ……………………………………………………………………………………… 189
２つの被験者間要因(２Ｂ) ……………………………………………………………………………………… 193
１つの被験者間要因と１つの被験者内要因(１Ｂ１Ｗ) ……………………………………………………… 1202
２つの被験者内要因(２Ｗ) ……………………………………………………………………………………… 208
３つの被験者間要因(３Ｂ) ……………………………………………………………………………………… 213
２つの被験者間要因と１つの被験者内要因(２Ｂ１Ｗ) ……………………………………………………… 224
１つの被験者間要因と２つの被験者内要因(１Ｂ２Ｗ) ……………………………………………………… 230
5

名古屋大学

大学院教育発達科学研究科・教育学部

３つの被験者内要因(３Ｗ) ……………………………………………………………………………………… 237

１０

分布の位置に関する推測 ― ノンパラメトリック法

対応のある２群の分布の位置の比較 ― ウィルコクソンの符号順位検定 ………………………………… 244
対応のある多群の分布の位置の比較 ― フリードマンの検定 ……………………………………………… 246
対応のない２群の分布の位置の比較 ― ウィルコクソンの順位和検定(マン・ホイットニーの検定) …… 248
対応のない多群の分布の位置の比較 ― クラスカル・ウォリスの検定 …………………………………… 250１１相関係数に関する推測

相関係数の推測 …………………………………………………………………………………………………… 252
相関係数行列の各要素の検定 …………………………………………………………………………………… 253
２群の相関係数の差の検定 ……………………………………………………………………………………… 254
２群の相関係数の差の信頼区間 ………………………………………………………………………………… 255
多群の相関係数の等質性の推測 ………………………………………………………………………………… 257

１２

分割表に関する推測 ― χ2 検定・フィッシャーの正確検定

２×２表 ― ファイ係数，カイ2乗検定，尤度比検定，フィッシャーの正確検定 ………………………… 260
ｒ×ｃ表 ― クラメルの連関係数，カイ2乗検定，尤度比検定 ……………………………………………… 263
ピアソン残差・デビアンス残差 ………………………………………………………………………………… 266
２名の評定者の評定の一致度 ― コーエンのカッパ係数 …………………………………………………… 269
複数名の評定者の評定の一致度 ― Fleissのカッパ係数 …………………………………………………… 271

１３比率に関する推測

１群の比率の推測 ― 二項検定 ………………………………………………………………………………… 272
対応のある２群の比率の比較 ― マクネマーの検定 ………………………………………………………… 273
対応のある多群の比率の比較 ― コクランのＱ検定 ………………………………………………………… 275
リスク差・リスク比・オッズ比の推測 ………………………………………………………………………… 277
対応のない多群の比率の等質性の推測 ………………………………………………………………………… 282

１４

線形回帰分析

単回帰分析 ― lm関数 …………………………………………………………………………………………… 284
重回帰分析 ― lm関数 …………………………………………………………………………………………… 286
重回帰分析 ― glm関数 …………………………………………………………………………………………… 289
重回帰分析 ― sem関数 …………………………………………………………………………………………… 291
主成分得点を用いた重回帰分析 ………………………………………………………………………………… 296

１５

パス解析

パス解析 ― specifyEquations関数 …………………………………………………………………………… 299
パス解析 ― specifyModel関数 ………………………………………………………………………………… 303
多母集団のパス解析 ― specifyEquations関数 ……………………………………………………………… 307
多母集団のパス解析 ― specifyModel関数 …………………………………………………………………… 311
多母集団パス解析におけるパス係数の検定 …………………………………………………………………… 315

１６

因子分析

確認的因子分析 …………………………………………………………………………………………………… 321
探索的因子分析 …………………………………………………………………………………………………… 326
２次因子分析 ……………………………………………………………………………………………………… 329
階層因子分析 ……………………………………………………………………………………………………… 335

１７

潜在変数のある構造方程式モデリング（共分散構造分析）

多重指標モデル …………………………………………………………………………………………………… 342
潜在変数のある構造方程式モデリング ― semパッケージ …………………………………………………… 345
潜在変数のある構造方程式モデリング ― lavaanパッケージ ……………………………………………… 349
成長曲線モデル ― lavaan パッケージ ………………………………………………………………………… 353
多母集団分析 ― semパッケージ ………………………………………………………………………………… 356
6

名古屋大学

大学院教育発達科学研究科・教育学部

多母集団分析 ― lavaanパッケージ …………………………………………………………………………… 363
等値制約 ― semパッケージ ……………………………………………………………………………………… 368
等値制約 ― lavaanパッケージ ………………………………………………………………………………… 374

１８さまざまな多変量データ解析

クラスター分析 …………………………………………………………………………………………………… 378
対応分析 …………………………………………………………………………………………………………… 382
多重対応分析 ……………………………………………………………………………………………………… 385
主成分分析 ………………………………………………………………………………………………………… 389
主成分回帰分析・PLS回帰分析 …………………………………………………………………………………… 391
ロジスティック回帰分析 ― 素データ ………………………………………………………………………… 394
ロジスティック回帰分析 ― 集計データ ……………………………………………………………………… 397
多項ロジスティック回帰分析 …………………………………………………………………………………… 400
対数線形モデル ― glm関数 ……………………………………………………………………………………… 403
対数線形モデル ― loglm関数 …………………………………………………………………………………… 410
カウントデータの分析 …………………………………………………………………………………………… 417

１９階層線形モデル（マルチレベルモデル）

階層線形モデルの例 ……………………………………………………………………………………………… 419
Ｒで階層線形モデル分析をするためのデータ構造 …………………………………………………………… 420
階層線形モデル ― lmer関数 …………………………………………………………………………………… 421
階層線形モデル ― lme関数 …………………………………………………………………………………… 428

２０

検定力分析

２群の平均値 ……………………………………………………………………………………………………… 434
相関係数 …………………………………………………………………………………………………………… 436
クロス集計表 ……………………………………………………………………………………………………… 438
２群の比率 ………………………………………………………………………………………………………… 440
１つの被験者間要因(１Ｂ) ……………………………………………………………………………………… 443
１つの被験者内要因(１Ｗ) ……………………………………………………………………………………… 446
２つの被験者間要因(２Ｂ) ……………………………………………………………………………………… 449
１つの被験者間要因と１つの被験者内要因(１Ｂ１Ｗ) ……………………………………………………… 453
２つの被験者内要因(２Ｗ) ……………………………………………………………………………………… 458

２１

信頼区間に基づく標本サイズの推定

１群の平均値 ……………………………………………………………………………………………………… 463
２群の平均値 ……………………………………………………………………………………………………… 464
相関係数 …………………………………………………………………………………………………………… 465
比率 ………………………………………………………………………………………………………………… 466

２２

項目分析

項目分析 － 自作関数 …………………………………………………………………………………………… 467
項目分析 － itemanalysisパッケージ ………………………………………………………………………… 477

２３

項目応答理論

項目パラメタの推定 ― 1PL,2PL,3PLモデル …………………………………………………………………… 481
特性関数・情報関数の図示 ……………………………………………………………………………………… 485
特性値の推定 ……………………………………………………………………………………………………… 487
局所独立性の確認 ……………………………………………………………………………………………… 489
等化 ― 共通項目法 ……………………………………………………………………………………………… 492
ＤＩＦ分析 ………………………………………………………………………………………………………… 498

２４

付録

文字列関数 ― 文字列の切り出し・結合・検索・置換 ……………………………………………………… 504
演算記号・算術関数 ……………………………………………………………………………………………… 507
切り上げ・切り下げ・四捨五入 ………………………………………………………………………………… 509
集合関数 …………………………………………………………………………………………………………… 511
7

名古屋大学

大学院教育発達科学研究科・教育学部

比較演算子 ………………………………………………………………………………………………………… 512
論理演算子 ………………………………………………………………………………………………………… 513
ベクトルの生成 …………………………………………………………………………………………………… 514
ベクトルの要素の評価 …………………………………………………………………………………………… 515
行列演算 …………………………………………………………………………………………………………… 517
制御コマンド ……………………………………………………………………………………………………… 521
コマンドを生成して実行 ………………………………………………………………………………………… 524
一括分析・総当たりの分析 ……………………………………………………………………………………… 527
関数の作成 ………………………………………………………………………………………………………… 530
スクリプトの呼び出し …………………………………………………………………………………………… 531
多変量正規乱数の発生 …………………………………………………………………………………………… 532
確率関数 …………………………………………………………………………………………………………… 534
いくつかの図をまとめてPDFファイルに出力 …………………………………………………………………… 535
正規分布と標準得点の対応関係の図を描く …………………………………………………………………… 537
統計的有意性検定の概念図を描く ……………………………………………………………………………… 541
同なるべくグループメンバーが重ならないグループ分けを複数回行う …………………………………… 543

8

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Ｒの概要
Ｒの画面

どういうものか・統計分析や統計図表の作成ができる
・SPSS や EXCELより， SAS や FORTRAN に近い・スクリプト（プログラム）を書く
・本体とパッケージからなる
本体
データ管理，編集，領域普遍的な分析パッケージ 領域固有的な分析，便利機能
デメリット
・取っ付きが悪い・関数名や文法を知らないと使えない
・正しくスクリプト（プログラム）を書かないと動かない
・パッケージが山のようにあって，どれを使えば良いのか調べるのが大変
・同じ分析を実行するパッケージや関数が複数あったりする
分散分析
aov，anova，Anova
共分散構造分析 sem，lavaan
・異なるパッケージの中に，同じ名前の関数があったりする・パッケージ，関数によって，仮定や数値計算法の違いなどから，結果が多少異なることがある
メリット
・フリーソフト・世界標準・世界中のボランティア開発者が，よってたかってパッケージを開発
・新しい分析機能がどんどん追加されていく・信頼性が高い・分析のスクリプト（プログラム）を保存
同じ分析を簡単に再現できる
ＳＰＳＳは分析結果を保存し，過程を保存しないので，過去の分析を再現するのが難しいことがある
Ｒは，分析結果ではなく，スクリプト（分析方法，過程）を保存するので，結果を容易に再現できる

9

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Ｒを使うための準備
Ｒを使うにあたって必要なもの
・インターネットにつながるパソコン
Ｒをダウンロード・実行するのに必要
Windows，Mac，Linux いずれでもよい（本スクリプト集は基本的にWindows環境で作成しています）
・エクセルなどデータ入力できるソフト
データをCSV形式で保存するのに使う
他の形式（エクセル形式など）でも構わないのだが，汎用性の高いＣＳＶ形式を推奨
表入力・CSV保存できるソフトなら何でも構わない＊ Google Colaboratory を使って，インターネット上で R を使うこともできます。その場合は，Google ア
カウントが必要です。
Google Colaboratory でRを実行する場合は，OSの違いはあまり意識しないで済みますが，インターネッ
トへの常時接続が必要である，CSVデータを毎回アップロードしなければならない，利用時間に制約があるなど，いくつか不便な点もあります。

Ｒを使うにあたって必要なこと・所定のWebサイトからＲファイルをダウンロードしてパソコンにＲをインストールする
フリーソフトなので料金はかからない
安全なソフトとされている・エクセル等でデータを入力しCSV形式で保存する
データのある場所が，Ｒの作業領域になるので，処理の速さが気にならなければUSBなどの外部メモリに保存しておくで良い。（バックアップは別に取っておく）
・Ｒで分析を行うための，スクリプト（プログラム）の書き方，関数名を覚える
データの読み込み，書き出しのためのスクリプト
分析のためのスクリプト
データ加工のためのスクリプト など
おそらくこの部分が一番のハードルになる

ファイルの拡張子を表示させる
たいていの場合，コンピュータ上のファイル名には，拡張子というものがついています。～.pdf，～.docxの.pdfや.docxなどです。ファイルの属性を表すのに用いられています。
Windowsのエクスプローラは，初期設定では拡張子を表示しません。この状態だと，～の部分が同じファイ
ル名のファイルが，PDFファイルなのかWordファイルなのか，表示されるファイル名だけでは分からなくなります。
そこで，エクスプローラにおいて，拡張子も表示させるように設定を変更しておきます。
エクスプローラ → 表示 → ファイル名拡張子にクリック としてください。そうすると，拡張子がついたファイル名が表示されます。
ファイルの種類を確認するためにも，拡張子を常に表示させることをお勧めします。

10

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

管理者権限について
Windowsマシンの場合，管理者としてパソコンを実行していないとＲをインストールできないことがある。
このような場合は，パソコンの管理者にＲをインストールしてもらうか，自分にも管理者権限を持たせてもらうかする必要がある。Macの場合は，管理者権限がないとRを実行できないので，管理者権限を意識することはまずない。
管理者権限を持っていなくてもＲを使うことはできる。しかし，Ｒを管理者権限として実行できていないと，パッケージをインストールした際，Ｒのライブラリフォルダに保存されず，別のフォルダにインストー
ルされる場合がある．例えば，パッケージのインストールを行った際，以下のような警告メッセージが出ることがある．
Warning in install.packages(NULL, .libPaths()[1L], dependencies = NA, type = type) :'lib = "C:/Program Files/R/R-3.2.0/library"' は書き込み可能ではありません
ダウンロードされたパッケージは、以下にあります
C:\Users\◯◯◯\AppData\Local\Temp\RtmpWi0uAi\downloaded_packages
このような状況では，パッケージはＲ本体とは別のフォルダにインストールされているため，library()関
数で読み込もうとしても，「○○というパッケージはありません」というエラーが出る．
上のような状況を解決するためには，管理者権限のあるユーザーとしてＲを実行して，パッケージをイン
ストールする．Ｒを管理者権限として実行するためには，Ｒのプロパティを変更する．

デスクトップ上のＲのアイコン上で右クリックし，左のようなメニューを表示し，メニューの中から，「プロパティ」を選択する．

「プロパティ」を選択すると，左のようなウィンドウが表示される．
プロパティウィンドウにある複数のタブの中から，「互換性」タブを選択する。
「すべてのユーザーの設定を変更」のボタンをクリックする．

11

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部「管理者としてこのプログラムを実行する」のチェックボックスにチェックを入れ，「適用」を選択する．
表示させたすべてのウィンドウについて「OK」を選択して閉じる．
次にＲを起動したとき，「コンピュータへの変更を許可しますか？」と聞かれたら「はい」として続行する。
これで，管理者としての実行が可能となるので，この状態で，パッケージのインストールをすればよい。

インストール後，Rを起動するとき，デスクトップ上のＲのアイコンをクリックして起動しない場合は，Rのアイコン上で右クリックし，「管理者として実行」を選択する．

12

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Ｒのインストール【注意】 管理者または管理者権限を持ったユーザーとしてパソコンを起動（ログイン）している必要がある．
管理者権限については前項参照。
http://www.r-project.org/
を開く．
Downloadの下にある CRAN を
クリックして，最寄りのミラーサイトを選ぶ．

一番上の 0-cloud，もしくは，
Japan の The Institute of S
tatistical Mathematics, Tok
yo からダウンロードするのが分かりやすい．

Download and Instal R で，
Mac, Windows, Linux のうち，自分の使っているコンピュー
タにあうものを選ぶ．

13

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部
baseを選択する．

当初リリースの不具合を修正したPatched buildがあればクリックする。

一番上のDownload R… を選ぶ。

14

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ファイルを保存するか聞いてくるので，保存するを選ぶ．
ダウンロードしたファイルが，「ダウンロード」というフォルダか，「デスクトップ」か，どこかにあるはずなので，探し出す．

デスクトップに保存した場合ダウンロードフォルダ等に保存した場合ダウンロードしたファイル「R-○○.exe」をダブルクリックして，インストールを開始する．
○○のところは，RのバージョンやOSなどにより異なる．

利用言語を選びOKとする

特に構わなければ次へ 次へ 次へ…

32bitマシンか 6
4bit マシンか選択できるときは，
自分のあてはまるほうを選ぶ．
（あてはまらな
いほうのチェッ
クを外す）

15

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部「デスクトップ
上にアイコンを作成する」にチェックを入れる

インストール中の画面

インストール完了の画面

インストールができたら，画面上にこんなアイコンができているはず．

以上でRのダウンロードは終了．

16

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Ｒの起動と終了
画面上にある左にあるようなアイコンをクリックすると，Ｒが起動する．
アイコンがない場合には，スタートメニューから起動する．

Rが起動すると左図の画面が開き，Rが起動する．

右上の×を推すと，Rが閉じる．

Rを閉じるとき，作業内容を保存するかどうか聞いてくるので，「はい」か「いいえ」かを答える．
「はい」を選択すると「.RData」という拡張子のついたファイルが作成される。そのファイルを開くとRが起動し，そのファイルを作成した段階のメモリ状態となる（スクリプトは出てこない）。
とくに必要なければ，ここは「いいえ」で良い。

最新のスクリプトが保存されていないときは，
最新のスクリプトを保存するか聞いてくるので，「はい」か「いいえ」かを答える．「はい」とした場合には，スクリプトの保存が行われる．
その後，改めてRを終了する．

17

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

パッケージのインストール【注意】 管理者または管理者権限を持ったユーザーとしてパソコンを起動し，管理者としてＲを起動している必要がある．
Rには，本体の他にパッケージというものがあり，パッケージに含まれる関数を使うためには，まずパッケージのインストールをする必要がある．ただし，パッケージにも，MASSのようにＲをインストールしたときに同時にコンピュータにインストールされるものと，psychやsemのようにＲをインストールしたときにはコンピュータにインストールされないものとがある．以下は，後者のパッケージのインストールの説明である．
パッケージのインストールは，原則として当該コンピュータで一度だけやればよいが，Ｒのバージョンア
ップをしたり，システムの復元をしたりすると，過去のパッケージがインストールされていない状態に戻ることがあるので，その場合は改めてインストールする．
パッケージに含まれる各コマンドについては，Rをインストールしたフォルダの中にそのパッケージ名のフォルダができていれば，その中にパッケージのマニュアルがあるので参照するとよい．
プルダウンニューを使う方法(1) 「パッケージ」→「パッケージのインストール」とする．
(2) ミラーサイトを設定する画面が出てくるので，0-cloud，もしくは，JapanのTokyoなど最寄りのミラーサ
イトを選択する．
(3) パーケージのリストが出てくるので，必要なパッケージ（psych や sem など）を選ぶ．

Ｒのコマンドを使う方法(1) Ｒのコンソール画面上に以下を入力し実行する
install.packages(c("パッケージ名1","パッケージ名2",…), dependencies = TRUE)
パッケージ名のところは，psych や sem など，自分が必要とするパッケージの名前を書く．
c()の中に複数のパッケージ名を書くと，複数のパッケージを一括してインストールすることができる．
dependencies = TRUE と指定しておくと，依存するパッケージもインストールしてくれる(2) ミラーサイトを設定する画面が出てくるので，0-cloud，もしくは，JapanのTokyoなど最寄りのミラーサ
イトを選択する．
本スクリプト集で使用するパッケージの一括インストール
install.packages(c("agricolae","ca","car","coefficientalpha","compute.es","corpcor","CVST","descr","DescTools","difR","effectsize","epitools","FactoMineR","fdth","gmodels","GPArotation","irr","irtoys","itemanalysis","lavaan","lme4","lsr","ltm","MBESS","nlme","phia","pls","polycor","psych","pwr","sem","vcd","VGAM"), dependencies = TRUE)

18

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

パッケージの読み込み・取り外しパッケージは，Ｒをインストールしたときに同時にインストールされるものでも，後からインストールしたものでも，読み込みをてからでないと使用できない．
インストールはできたはずのに，パッケージを読み込めない場合は，インストールがうまくできていない可能性がある。その場合は，管理者としてＲを起動させて，パッケージをインストールするとうまく行くことが多い（次項参照）。
読み込み
library(パッケージ名)
上記スクリプトを書いて実行すると，そのパッケージが読み込まれる．
パッケージ名を""で囲わない．
読み込み後なら，ヘルプを使って，そのパッケージに含まれる関数の使い方を読むことができる．
取り外し
detach("package:パッケージ名")異なるパッケージが同一の関数名を使用しているときに，その２つのパッケージを読み込むと，どちらか一方のパッケージの関数が使えなくなる．これを避けるために，不要なほうのパッケージを取り外す．
一度取り外したパッケージでも，library() でまた読み込むことができる（再インストールする必要はない）．

19

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

スクリプトの新規作成・保存・読み込み
Rは，スクリプトと言われるプログラムを書いてそれを実行する，という使い方をする．
スクリプトは，Rエディタで開き，実行する範囲を指定して実行する．
実行結果は，コンソール（Console）画面や，グラフィクス（Graphics）画面に出力される．
新規作成
スクリプトを最初に書くときは，Ｒを起動し，「ファイル」→「新しいスクリプ
ト」を選択する．

スクリプトを書く画面（Rエディタ）が表示されるので，ここにスクリプト（プログラム）を書く．

スクリプトを書いたところ

20

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

保存
スクリプト（プログラム）を書いたら「ファイル」→「別名で保存」とする．

保存するフォルダを設定する画面が開くので，ドライ
ブ，フォルダを選択移動し，ファイル名のところに「ファイル名」を入力する．
ファイル名は，変な記号を使わなければ，基本的に何でも良い。
保存すると，自動的に「.R」という拡張子がつく。

読み込み

スクリプトを閉じたあとや，Rを終了した後などに，保存したスクリプトを再び開くときは，Rを起動し，「ファイル」→「スクリプトを開く」とする．

開くファイルを指定する画面が開くので，ドライブ，
フォルダを選択移動し，目的のファイルを選択して，「開く」を押す．
読み込んだスクリプトを再編集して保存するときも，「別名で保存」からファイル名を指定して保存きする
ほうが間違いがない．「上書き保存」ではファイル名
が文字化けすることがある。
同名保存する場合，「既に存在します．上書きしますか？」と訊いてくるので，良ければ「OK」を押す．

21

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

スクリプトの実行
スクリプトの実行したい部分を選択する．スク
リプト全体を選択するのであれば，スクリプト
エディタ上で右クリックし，「全て選択」を選
ぶ．

スクリプトエディタ上で右クリックし，「カーソル行または選択中のRコードを実行」を選ぶ．

スクリプトが実行され，結果が表示される．
スクリプトとともに，コンソール画面に結果が，表示される．
実行されたスクリプトは，コンソール画面上において，「> 」が左端について表示される．
図は，グラフィクス画面に出力される．
スクリプトは，毎回すべて実行する必要はありません。実行したい部分だけを選択して実行することができます。
ただし，前の分析結果が残っていたりして，古い分析結果が出力されてしまう危険性もあります。
スクリプトがすべて完成したら，一度，すべてを選択して実行することをお勧めします。

22

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

オブジェクトの確認・消去
Rでは，計算や分析の結果をメモリ上に"オブジェクト"として再利用することができる．
オブジェクトを生成するには，たとえば「r1 <- c(1,2,3)」とすると，r1という名前で，1,2,3 を要素に持つベクトルが生成される．
例えば，スクリプトにミスがあるのに，同名の古いオブジェクトが残っていると，過去の結果がいつまでも使われて，ミスに気がつかないことがある．
そこで，いまメモリ上にあるオブジェクト名を確認したり，オブジェクトを消去したりする必要がある．
新しく分析を始めるときは，いったんメモリ上のオブジェクトを消去しておいたほうがよい．

メモリ上にあるオブジェクト名を確認
ls()
メモリ上にあるすべてのオブジェクトを消去
rm(list=ls())> r1 <- c(1,2,3)> r1[1] 1 2 3> ls()[1] "r1"> rm(list=ls())> ls()
character(0)
> r1
エラー：

オブジェクト 'r1' がありません23名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ヘルプの使い方
使うコマンド（関数名）のスペルが分かっている場合「ヘルプ」→「Rの関数（テキスト）」とす
ると，次の入力画面が表示されるので，コ
マンドのスペルを入力して使い方を調べればよい．

使うべきコマンド（関数名）がよくわからない場合：キーワード検索「ヘルプ」→「ヘルプの検索」とすると，次の入力画面が表示されるので，キーワー
ドを入力する．

たとえば，「mean」というキーワードを入力すると，「mean」を含むヘルプ文書の一覧を表示してくれるので，その中からコマンド（関数名）を選んで，上の方法で関数のヘルプを見る．

24

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

スクリプトの外部ファイルへのコピー
スクリプトの実行したい部分を選択する．スク
リプト全体を選択するのであれば，スクリプト
エディタ上で右クリックし「全て選択」を選ぶ．
スクリプトエディタ上で右クリックし「コピー」
を選ぶか，「CTRL＋C」キーを押す．

Wordなどを起動し，スクリプトをペースト（貼り付け）する．（一太郎などでも構わない）

ドライブ，フォルダを移動し，「ファイル」→「名前をつけて保存」を選んで，ファイル名のところに，任意の名前を書いて「保存」する．

25

名古屋 大学
出力結果の外部保存

大 学院 教育発 達科 学研 究科・ 教育 学部－ Wordファイルなどに保存

コピー・ペーストを使う．
コピー・ペーストを使う方法
Rコンソール画面の該当箇所を範囲選択して，「編集」→「コピー」とするか，「CRTL+
C」キーを押す．

Wordなど，適当なソフトを起動し，ペースト（貼り付け）する．

「ファイル」→「名前をつけて保存」と進
み，ドライブ，フォルダを指定して，ファイル名のところに任意の名前を書いて「保
存」する．

26

名古屋 大学
出力結果の外部保存

大 学院 教育発 達科 学研 究科・ 教育 学部－ sink関数

sink関数を使う方法
sink("ファイル名.txt")
Rスクリプトsink()
結果のみが保存され，スクリプト部分は保存されない．
コンソール画面には，結果は表示されない．
Append=T オプションをつけないと，ファイルは上書きされる．
ファイルが開いていると保存されない．

> setwd("d:\\")> d1 <- read.table("度数分布_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>>> # sink で結果をファイルに出力するようにする> sink("sinkout1.txt")>> #最初の数行を表示> head(d1)>> # 標本サイズ> (n.score <- nrow(d1))>> # 最小値，中央値，平均値，最大値，四分位など> (summary.score <- summary(d1$score))>> # 標準偏差> (sd.score <- sd(d1$score))>> # 結果をまとめて出力> c(n.score, summary.score, sd.score)>> # ファイルを閉じる> sink()> # コンソール画面には結果は表示されない

27

名古屋 大学

Wordなどを使って，出力結果を確認する

28

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学図の外部保存大 学院 教育発 達科 学研 究科・ 教育 学部－ Wordファイルなどに貼りつけ

グラフィックス画面上で右クリックし，「メタファイルにコピー」を選択する．
もしくは，図上で左クリックし，「CTRL」＋「C」
キー（macの場合は「Command」＋「C」）キーを押す。
貼り付け先によっては，「メタファイルにコピー」
だと背景が透明になり，「CTRL」＋「C」だと背景が白になる．
メタファイルに保存やポストスクリプトに保存を選択すると，画像ファイルとして保存することができる。

Wordなどを起動し，ペースト（貼り付け）し，保存する．
もしくは，「CTRL」＋「V」キー（macの場合は「Command」＋「V」）
キーを押して貼り付ける。
図を貼り付けたファイルをWordファイルとして保存する。

同様にして，1つのWordファイ
ルに何枚も図を貼り付けることができる。

画像ファイルとして保存した図をWordに貼り付けたい場合は，次のようにする。
1)

エクスプローラを開き，画像ファイルが保存されているフォルダを表示する。

2) Wordを起動する。新規にファイルを開くか，既存のファイルを開く。
3) Wordの画面上に，エクスプローラから画像ファイルをドラッグ＆ドロップする。これで画像がWord上にコピーされるはず。

29

名古屋 大学図の外部保存大 学院 教育発 達科 学研 究科・ 教育 学部－ PDFファイルに保存

図の出力先をBMP, JPEG, PNG, TIFF, PDF形式ファイルにする bmp, jpeg, png, tiff, pdf 関数もある．
図を作成する関数の前にこれらの関数を置いておくと，指定された形式のファイルに図が出力ができる．
pdf("ファイル名.pdf", paper="a4", width=8, height=16, family="Japan1")
layout(matrix(c(1,2,3,4,5,6), 3,2, byrow=TRUE))# 図を作成するスクリプトをここに書く
layout(1)dev.off()> setwd("e:\\R課題\\")>>> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
> # 男だけのデータ> d1m <- d1[d1$性別=="男",]>> # PDF ファイルに図を保存> pdf("histgram.pdf", paper="a4", width=8, height=16, family="Japan1")> layout(matrix(c(1,2), 2,1, byrow=TRUE))>> hist(d1$自己効力感, breaks=seq(20,85, by=5), ylim=c(0,60), las=1, xlab="自己効力感",> hist(d1m$自己効力感, col="gray")>> layout(1)> dev.off()
windows2>30

main="")

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

出力結果をエクセルで整形保存
表などは，エクセルの機能を使って，見やすい形に整形保存することができる。
R Consoleウィンドウの大きさを調整して，表が綺麗に表示されるよ
うにしておく。

Ｒ スクリプトを実行し，実行結果
をR console画面に表示させる。

エクセルに貼り付けたい部分を範囲選択してコピーする。

31

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

コピーした部分をエクセルに貼り付ける。

「データ」メニューの「区切り位置」
を選択する。

データを区切る形式を聞かれるので，「スペース」を選び，次に進む。

区切り位置が表示されるので，修正の必要があれば区切り位置を調節する。修正の必要がなければ，次に進む。

32

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

データ形式（標準，文字列，日付など）の確認画面が表示されるので，修正の必要があれば修正する。必要なければ，完了する。

データがセルごとに区切られ，見やすい表の形式となる。

エクセル でファイル保
存する。

33

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Ｒの情報源
公式ホームページ
http://www.r-project.org/

日本語のRの情報集積ページ
http://www.okadajp.org/RWiki/

青木繁伸先生のRのページ
http://aoki2.si.gunma-u.ac.jp/R/index.html

服部環先生のご著書
心理・教育のためのRによるデータ解析
福村出版
2011/04

他にもたくさんあります．

34

山田・村井・杉澤先生のご著書
Rによる心理データ解析
ナカニシヤ出版2015/9/10

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Mac版のＲで作業ディレクトリを設定
２通りある
setwdを使って作業ディレクトリを指定する方法
下図のように，あるフォルダにCSVファイルが入っている場合，のアイコンを押し，そのままＲのスクリプト作成画面へ移動して離す。

すると，フォルダの絶対パス：/Volumes/TOSHIBA/scripts が得られる。
これをダブルクォーテーションで括って，setwd()の中に入れる。
setwd("/Volumes/TOSHIBA/scripts")
これを実行する。
【重要！】
MacOS Mojaveでは，フォルダアイコンを押してＲのスクリプト作成画面へ貼り付けることができない。その場合は，設定アイコンの中から「○○のパス名をコピー」を選択し，Ｒのスクリプトエディタに貼り付けられる。また，作業ディレクトリとして指定するフォルダを選択の上，「Option」+「Command」＋「C」
を同時に押すことにより，絶対パス名をコピーすることもできる。
Macの場合は，必ず半角スラッシュ「/」で始める。Windowsで作成したスクリプトを，Macでそのまま通したり，Windows流にバックスラッシュ「\」でフォルダの階層を表現するとエラーが出る。
半角スラッシュは，1つでも2つでも認識する。
setwd("/Volumes/TOSHIBA/scripts")
setwd("//Volumes//TOSHIBA//scripts")
どちらでもよい。

35

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ツールバーから作業ディレクトリを設定する方法
Mac版Ｒのツールバーの中の「その他」タブから，「作業ディレクトリの変更」を選択する。

フォルダの選択画面がポップアップするので，CSVファイルの場所を選択し，「開く」を押す。
これでOK。

36

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Mac版のＲでread.table関数でCSVファイルを読み込み
Windowsと同じようにしてread.table関数でCSVファイルを読み込もうとすると，「不正なマルチバイト文字があります」というエラーが出ることがある。このようなエラーが出た場合は，エンコーディング方法を明示してＲに伝える必要がある。
read.tableのオプションで ，fileEncoding="cp932" を指定する。
（write.table関数等でも同様の指定が必要なことがある。）> setwd("//Volumes//TOSHIBA//scripts")> d1 <- read.table("対応のある2群の平均値データ.csv",header=TRUE,sep=",")
make.names(col.names, unique = TRUE) でエラー:'<8b><b3><97>{<89>?<da>' に不正なマルチバイト文字があります# エラーが発生> d1 <- read.table("対応のある2群の平均値データ.csv", header=TRUE, fileEncoding="cp932", sep=",")# 今度はうまく行った37

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Mac版のＲで図を描いたときに日本語を正しく表示させる
Mac版のRで図を描いたとき，日本語文字（全角文字）が□□と表示されることがある。このような場合は，par関数を使って図を描く前にフォントを指定しておく。
par(family="HiraKakuProN-W3")
フォント名（HiraKakuProN-W3）は他のものでもよい。

Mac OS版のＲスクリプトファイルをWindows版Ｒで読む場合のマルチバイト文字の文字化けへの対応
Mac版のＲでスクリプトファイルを作成した人が，Windowsマシンをもつ人とスクリプトを共有する際，日本語文字列が文字化けする。
これは，Mac版のＲのスクリプトエディタがUTF-8形式でエンコーディングするのに対し，Windows版のエディタではCP932形式でエンコーディングすることによる。
このようなときは，Mac版Ｒで作成したスクリプトファイルをテキストエディタ（ex.メモ帳）で読み込み，エンコーディング方法に「UTF-8(BOM付き)」を選択する。

38

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

R StudioについてRを実行するにはR本体があれば良いのであるが，より操作性を高めるものとして，R StudioというIDE（統合開発環境）が提供されている。R Studio を使うと，setwdの設定やパッケージのインストールをメニューで操作できたり，グラフが扱いやすくなったりする。他にもいろいろ便利な機能がある。
本スクリプト集は，R Studio を使わず，Rだけで実行できるように書かれているが，R Studio のインストール方法は以下の通りである。R Studioの使い方などは，別の情報源から収集のこと。
https://rstudio.com/ で R Studio のホームページにアクセスし，DOWNLOADを選択する。

Free版（または製品版）をDOWNLOAD

インストーラファイルを選択してダウンロード

39

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ダウンロードの進捗状況を表示するボタンを押し，ダウンロードしたファイルを実行
指示に従ってインストール
アプリケーションメニューにR Studioが登録される。

R Studioを起動したところ

40

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Google Colaboratory で R を使うための準備
インターネットに接続して，Google Colaboratory を使って R を実行することも可能。
分析結果をURLで他の人と共有することができる。
データを毎回アップロードしなければならない。
Google アカウントが必要
以下のページから作成できる。既に持っている場合はそれが使える
https://accounts.google.com/signup
環境
パソコンが必要。OSは何でもよい。
ブラウザは Google Chrome か Firefox を用いる。無い場合はダウンロードする
Microsoft Edge や Internet Explore では動作しない。
初期設定
以下のURLからGoogle Colaboratoryにアクセスする
https://colab.research.google.com
Googleアカウントでログイン
ファイル → ノートブックを新規作成
ファイル →(ダウンロード) → .ipynbをダウンロード を選択

41

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

メモ帳やテキストエディットなどを選んでプログラムから開く → OK
kernelspec の name の python 3 を ir
kernelspec の display_name の Python 3 を R に書き換え

ファイル → 名前を付けて保存 → USBのフォルダを選択
ファイル名を R.ipynbに書き換え → ファイルの種類を「すべてのファイル」に変更 → 保存

Macの場合，ファイル名をクリック →→ 移動

名前を R.ipynbに書き換え→ 場所→ その他 → USBフォルダ

新規作成した Google Colaboratory のページ に戻り，ファイル → ノートブックをアップロード を選択
参照をクリック → USBフォルダを開いて R.ipynbを選択 → 開く42

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ランタイム → ランタイムのタイプを変更 を選択
ランタイムのタイプが R になっていることを確認 → 保存
これでRを使う準備が完了
ファイル → 保存 として，R.ipynb ノートブックをColaboratory 上にも保存しておく

43

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Google Colaboratory で R を使う
Google Colaboratory にログイン → ノートブックを選択する画面が表示されるので， R.ipynb を選択
もしくはGoogle Colaboratory にログイン → ノートブックを選択する画面で アップロード → 参照 → フォルダを指定して R.ipynb を選択 → 開く
ノートブック名をクリック → ファイル名を書き換え（******.ipynb）→ ファイル → 保存

グレーのエリアがスクリプトを書く領域
実行するには，Shift+Enter を押すかマークを押す「＋コード」 を押すと，次のスクリプト入力領域が生成される【重要】Google Colaboratoy では，起動する度にパッケージをインストールしなければならない。
MASS，ggplotなどはプレインスートルされているので，改めてインストールする必要はない。

44

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Google Colaboratory にCSVデータをアップロードする
Google Colaboratory にログイン******.ipynb ファイルを読み込む
左バーにあるファイルアイコンをクリック → 少し待つ → ファイルエリア内で右クリック → アップロードを選択保存したCSVファイルを選択 → 開く → OK → ファイルが /contentディレクトリにアップロードされる【アップロードしたファイルは，ログアウトすると削除されてしまうので，次回ログイン時も，改めてアップロードする必要がある】

データの読み込み・表示
rm(list=ls())
read.table("CSVファイル名", オプション)
head(データフレーム名)# 作業メモリを消去する# データを読み込む# 先頭6行のデータを表示する# Shift-JIS コードのファイルを読み込むときは，オプションに fileEncoding="shift-jis" を設定する。

変数名
変数の型
データ

45

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Google Colaboratory に日本語フォントをインストールする
図で日本語文字を表示するためには，日本語フォントをインストールする必要がある
system(“apt-get -y install fonts-ipafont-gothic”) でフォントをインストールする
systemfonts::system_fonts() でフォントを確認する
par(family=“フォント名”) で，図で使うフォントを指定する
IPAGothic や IPAMinchoなどを使う

46

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Google Colaboratory のノートブックを保存する
Google Coraboratory で書いたスクリプトと分析結果は，ノートブック (.ipynbファイル)としてファイルに保存することができる。
ファイル → 保存

ノートブックをUSBやパソコンに保存する場合：ファイル → .ipynbをダウンロード → ファイルを保存 → ドライブやフォルダを指定して保存

47

名古屋 大学
Google Colaboratory のノートブックを共有する
共有 をクリック → リンクを知っている全員に変更 をクリック
リンクをコピー → 完了
ノートブックを共有したい人にリンク先URLを伝える

48

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

スクリプト作成にあたっての一般的注意
スクリプトの冒頭に作業メモリを空にするコマンドを書く
Rでは，以前に扱ったデータを保存しておいて，次にまた利用できるという機能があります。Rを終了する
ときに，「作業スペースを保存しますか？」で「はい」と答えると「～.RData」というファイルが作成されます。この「～.RData」というファイルを開くと，前に使っていたときのように，データが作業メモリ上に復活します。
便利なのですが，スクリプトにエラーがある場合に問題を起こすことがあります。スクリプトにエラーがあると，メモリ上のデータは上書きされません。しかし，何らかのデータがメモリ上に残っていればそれが使われるため，エラーがあっても実行結果が表示されてしまいます。たとえば，新しいデータを読み込んで分析結果を表示させるはずだったのに，古いデータの分析結果が残っていてそれが表示されてしまうというようなことがおこります。ですので，Rを終了するときに「作業スペースを保存しますか？」は「いいえ」と答えることをお勧めします。
作業メモリ上のデータを消去するため，Rスクリプトの先頭に，次の一文をいれておくことを推奨します。
rm(list=ls())
これを実行すると，メモリ上のデータが消去されます。rmは remove，ls()はすべてのリスト（作業メモリ上にあるデータ）を意味します。つまり，上のスクリプトは，消去しなさい(rm)，対象リストは(list=)，すべてのリスト(ls())です，という命令になります。

バックスラッシュと円マーク
Rで作業ディレクトリを設定するとき，バックスラッシュ ＼ もしくは円マーク ￥ が出てきます（実際はいずれも半角）。同じ記号を２つ入れます（詳しくは，本スクリプト集の「作業ディレクトリの設定」の項を参照）。
コンピュータでは，バックスラッシュと円マークに同じコード番号を使っているため，その番号をどう翻訳するかで表示が変わってきます。
コード番号を記号に変換する翻訳体系として，UTF とか，Shift JIS などがあり，どの体系を使うかで，表示される記号が異なってきます。
コード番号は同じなので，スクリプト上の記号がどちらになっていても，問題はありません。
Rに限らず，コンピュータでソフトを使っているとき，コード翻訳体系を変えるとうまく動かないこともありますので，ソフトが指定してくるコード体系のままにしておいたほうが無難です。
つまり，バックスラッシュで表示されるならそのまま，円マークで表示されるならそのまま，コピーペー
ストして変わるなら変わったままにしておきます。
とりあえずは慣れて下さい。どうしても気になるときはコード体系を変えることが考えられますが，他に影響がでる可能性もあるので注意して下さい。

コメントを書くときは # を使う
スクリプト中でコメントを書きたいこともあります。そのような場合は，シャープ記号 # （半角）を用います。Rは，#で始まる文を読み飛ばします。例えば，# 統計学レポート課題３と冒頭に書いておくと，そのスクリプトが何のためのものか分かります。また，
xa <- abs(x)# xの絶対値のように，命令文の右にコメントを書くことも可能です。

49

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

半角ｶﾅ文字を使わない
Rは世界中で使われているソフトなので，日本語対応が完全でない場合があります。とくに半角ｶﾅ文字は特殊で，半角ｶﾅ文字を使用していることでエラーになることも多くあります。
それゆえ，データ，変数名，ファイル名，フォルダ名等のいずれにおいても，半角ｶﾅ文字は使用しないことを強く推奨します。どうしてもカナ文字を使う必要がある場合は，全角カナ文字を用いるようにします。

全角文字もなるべく使わない
半角ｶﾅ文字と同様，全角文字も使わないに越したことはありません。全角文字を使用していることでエラーになることがあります。Rを使うものについては，データ，変数名，ファイル名，フォルダ名等のいずれにおいても，なるべく全角文字は使わず，半角英数文字を使うことをお勧めします。
スクリプト画面においては，全角のスペースやカッコと，半角のスペースやカッコとの見分けがつきにく
く，エラーのもとになります。ファイル名や変数名で全角文字を使用したときは，とくに注意が必要です。
なお，変数名については，ごく簡単な英単語を除き，ローマ字表記するのが分かりやすいです。

スクリプトの各行の先頭に「>」「+」「1:」などを書かない
スクリプトを実行すると，コンソール画面では，スクリプトの左端に「>」「+」「1:」などの記号をつけて表示します。「>」は各命令文の始まり，「+」や「1:」は命令文中の改行を意味します。コンソール画面の出力を参考にしてスクリプトを書くときは，これらの記号を外して（書かないで），スクリプトを書くようにしてください。

データファイルの変数名とRスクリプトの変数名を一致させる
データファイル（CSVファイル）の変数名と，Rスクリプトの変数名が一致していないと，エラーになります。注意しなければならないのは，CSVファイルの変数名におけるスペース（半角，全角）やハイフン（-）
は，Rでは「.」（半角ピリオド）に変換されることです。
たとえば，CSVファイルでの「x 2」（半角x 半角スペース 半角2）という変数名は，R上では「x.2」（半角X
半角ピリオド 半角2）となります。Rで「x 2」という変数を使おうとしても，「x 2」という変数はないので（あるのは x.2），エラーとなります。この場合は，CSVファイルの変数名を x2 とするか，Rのスクリプトをx.2 とするかの，いずれかを行う必要があります。
このように混乱のもとになるので，データファイルの変数名にはスペースやハイフンを入れず，なるべく
英数半角文字で書くことをお勧めします。ただし，先頭に数字を使うことはできません。
なお，例えば「情緒的サポート」の変数名を，support.emotion, supportEmotion, support_emothion な
どと書くように決めておくと，「道具的サポート」は，support.tangible, supportTangible, support_tangi
ble のように統一的に表記することができ，何の変数であるかが分かりやすくなります。

Rの予約語をオブジェクト名に用いない
if, for, TRUE, NA など予約語と言われるものは用途が限定されているので，たとえば，if <- 1 のように値を代入しようとしてもエラーになります。Rの予約語は以下の通りです。
for
in
TRUE
FALSE
NA_integer_

if
else
NULL
Inf
NA_real_repeat while
NaN
NA
NA_complex_

next
break
function
NA_character_50

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

pi，T，Fなどをオブジェクト名に用いない
また，pi，T，F はそれぞれ，円周率，TRUE，FALSE を意味する記号として初期設定されているので，これらの記号をオブジェクト名に使うのは避けるべきです。たとえば，pi はそのままでは円周率の値ですが，以下のように1という値を代入してしまうと，以降，円周率として使えなくなってしまいます。
> pi[1] 3.141593>> pi <- 1
>
> pi
[1] 1

代入結果を表示するときは当該のスクリプト部分を () で囲う
Rでは，命令文を実行した結果（データ，値，分析結果など）を「<-」を用いて代入保存することができます。例えば，
x <- mean(c(1,2,3,4))とすると，x には 1,2,3,4 という4つのデータの平均値 2.5 が代入されます。しかし，これを実行しても，コンソール画面上では，>

x <- mean(c(1,2,3,4))と表示されるのみで，xの値は表示されません。代入することしか命令されていないので，それを行ったらそれで終わりなのです。
結果を代入して，さらに，その値をコンソール画面上に表示させたいときは，(x <- mean(c(1,2,3,4)))のように，命令文全体を () で囲います。こうすると，> (x <- mean(c(1,2,3,4)))[1] 2.5のように結果が表示されます。

改行の位置に気をつける
スクリプトにおける改行のルールは基本的に以下の通りです。
・1つの行に複数の命令文を書くことは，基本的にはできない
例えば，head(d1)（d1の最初の数行を表示）と，nrow(d1)（d1の行数を表示）という2つの命令文を，
head(d1)nrow(d1)と書いてはいけないということです。

・1つの行に複数の命令文を書くときは，セミコロンなどで文を区切りを明示する
上記の場合，
head(d1); nrow(d1)とのように，間を ; で明示すれば，ここが切れ目だとRが理解することができるので，1つの行に複数の命令文を書くことができます。

51

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

・ひとかたまりの単語（や項）の途中で改行しない
例えば，10^rdgts（10のrdgts乗）というひとかたまりの項は，どこに改行をしてもいけないということです。これは，英単語を途中で改行してはいけないのと同じです。

・1つの命令文を複数の行に分けるときは，要素の切れ目で行変えする
例えば，
d1$gr <- cut(d1$x1, breaks=c(-Inf, med1, Inf), right=F, labels=c("L","H"), ordered_result=TRUE)というスクリプトであれば，
d1$gr <- cut(d1$x1, breaks=c(-Inf, med1, Inf), right=F,labels=c("L","H"), ordered_result=TRUE)などとします。なお，改行したスクリプトを実行すると，コンソール画面では，> d1$gr <- cut(d1$x1, breaks=c(-Inf, med1, Inf), right=F,+labels=c("L","H"), ordered_result=TRUE)のように表示され，スクリプトの1行目に「>」，2行目以降に「+」がついて表示されます（「1:」のような番号がつくこともあります）。この「>」や「+」（および「1:」など）をスクリプトに書くとエラーになります
ので，気をつけてください。

・計算式では，演算記号の後で改行する
例えば，1+2+3+4+5を2行に分けるとき
1+2+3
+4+5
としてしまうと，1+2+3 と，4+5 という2つの計算式を入力したことになってしまい，実行すると 6 と 9 という2つの結果が出力されます。このような場合は，
1+2+3+
4+5と1行目は「+」の後で改行し，まだ式は完結していないことを示した上で2行目を書きます。そうすると1つの計算式と認識され，15 という結果が得られます。

・for文，if文等における改行
条件式は丸カッコ ()，命令文は波カッコ {} で括ります。命令文はセミコロン ; で区切って同じ行に書いても構いません。
if-else文では，if文の最後の } と else { は同じ行に書きます。
for(条件式){
命令文
命令文
…
}
if (条件式){
命令文
命令文…
} else {
命令文
命令文
…
}

52

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

欠測のあるデータの分析について
実際にデータを収集したときは，多くの場合で欠測データが生じます。欠測のあるデータをRで分析する場
合，多くの関数は自動的に欠測データを除外して分析しますが，いくつかの関数では NA （Not Available）という結果を返したり，欠測の処理の仕方によって異なる結果を出力するので注意が必要です。詳しくは，
本スクリプト集の「欠測値の扱い」の項を参照してください。

四捨五入について
Rで四捨五入を行う関数として round 関数があります。
round(数値, 小数点以下桁数)と設定することにより，指定した桁数までに数値を四捨五入します。桁数を省略したときは整数になります。
しかし，round関数について注意しなければならないのは，> round(1.5)[1] 2> round(2.5)[1] 2のようにとなることです。通常の四捨五入なら 2, 3 という結果になるはずですが，Rのround関数では，～5という数値があったとき，～が偶数なら切り捨て，～が奇数なら切り上げという計算をします。
通常の四捨五入を行うためには次のようにします。
sign(x)*(floor(abs(x)*10^p + 0.5)/10^p)signはxの符号(+,-)を与える関数，floorは小数点以下を切り捨てる関数，absは絶対値を求める関数，pは小数点以下の桁数です。詳しくは，本スクリプト集の「切り上げ，切り下げ，四捨五入」の項を参照してください。

作成したスクリプトを少しずつ実行して確認する
スクリプトをすべて書いてから実行するよりも，少し書いてはその部分を実行することを繰り返したほうが，エラーを早く見つけることができます。確認にあたって，いつも上から全部実行する必要はなく，必要な箇所だけを選択して実行します。
エラー修正（プログラムのデバッグ）にあたっては，上から順に必要箇所を選択し，実行結果を確かめて行きます。1命令文ごとに実行し，結果を確認することをお勧めします。
for文は複数行にわたりますので，例えば i <- 1 のように初期値を設定しておいて，for文の{}中を1命令文ずつ実行していきます。
if文やifelse文では，条件式だけを実行して TRUE か FALSE の値が得られるか確認します。データに欠測値があると NA という結果になり，エラーの原因となります。

図を複数描く場合も，1つずつ実行しないと最後の図しか画面上に残らなくなります。たとえば，データを読み込んで，クロス表，円グラフ，帯グラフをそれぞれ作成したい場合は，まず，データやパッケージを取り込みます。これは共通部分で，全体を通して1回だけ行えば十分です。
rm(list=ls())
setwd("d:\\Rreport\\")d1 <- read.table("度数分布_データ.csv", header=TRUE, sep=",", file=Encoding="shift-jis")library(descr)
そのあとクロス表を作成します。

53

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ctd1 <- CrossTable(d1$sex, d1$grade)
円グラフは次のスクリプトを実行することにより作成できます。
t.grade <- table(d1$grade)pie(t.grade, clockwise=TRUE)
帯グラフは以下を実行することにより作成されます。
t2 <- table(d1$grade, d1$sex)
p2 <- prop.table(t2, 2)
barplot(as.matrix(p2), horiz=TRUE, beside=FALSE, las=1, ylim=c(0,1), width=0.3, legend.text=T)segments(0, 0, 0, 1)
クロス表，円グラフ，帯グラフの手順はそれぞれ独立していますので，それぞれ当該のスクリプトだけを範囲選択して実行します。

54

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

よくある質問・エラー
データが読み込めない（rm, setwd, read.table）
Rを使い始めの頃に良くあるのが，データの読み込みエラーです。rm, setwd, read.table等の関数でエラーが発生している可能性があります。それぞれのエラーの原因と対処法について説明します。
USBに「Report」というフォルダを作り，その中に「data1.csv」というcsvデータファイル(Shift JIS コード) があるとします。
USBドライブが「D」ドライブなら，データ読み込みのスクリプトは次のようになります。
rm(list=ls())
setwd("D:\\Report\\")d1 <- read.table("data1.csv", header=TRUE, sep=",", file=Encoding="shift-jis")
ここで，もし rm の行に間違いがあったら，「... は名前あるいは文字列を含んでいなくてはなりません。」のようなエラーが出ます。rm(list=ls()) と正しく書かれているか確認してください。
もし setwd の行に間違いがあったら，「setwd("d:\\Rreport\\") でエラー: 作業ディレクトリを変更できません。」のようなエラーがでます。いまの場合，フォルダ名を「Rreport」と書き間違えていますので，「Report」と修正します。
もし read.table の行のファイル名に間違いがあったら，「 file(file, "rt") でエラー: コネクションを開くことができません
追加情報: 警告メッセージ:file(file, "rt") で:ファイル 'data.csv' を開くことができません: No such
file or directory」のようなエラーがでます。いまはファイル名を「data.csv」と間違えていますので，「data1.csv」とファイル名を正しく書き直します。
read.table の header や sep など，オプションの指定に間違いがあると，そのオプションは無視される
かエラーになります。エラーメッセージを表示してくれれば分かりますが，無視されたり，エラーメッセー
ジを表示することなく実行できない場合は，オプションに誤りがないか，自分で検討をつけ対応する必要があります。古い結果しか出力されない，オプションを書き換えても結果が変わらない，エラーは出ないのに実行結果に問題があるなどの場合は，オプションが正しく書かれているか確認してください。
フォルダ名，ファイル名は，Windowsであればエクスプローラで確認することができます。気をつけなければならないのは，エクスプローラでは最初，拡張子というものを表示していないことです。
.csvなどは拡張子と言って，そのファイルがどのような形式か，どのソフトに関連しているかを表す記号です。エクスプローラの上のほうにある「表示」をクリックして，「ファイル名拡張子」にクリックを入れて下さい。そうすると，拡張子がついたファイル名が表示されます。
拡張子がついたファイル名を表示したとき，ファイル名が「data1.csv.csv」などとなっていたら，ファイ
ル名をクリックして「data1.csv.csv」のように書き換えてください。

添え字が許される範囲外です と表示される
たとえば，以下のようなエラーが出たとします。
> describeBy(d1$tekiou, list(d1$future), mat=TRUE, digits=2)`[<-`(`*tmp*`, var, group + 1, value = dim.names[[group]][[groupi]]) でエラー:
添え字が許される範囲外です
このような場合は，指定したデータや変数に何らかの問題があります。たいていの場合，そういう名前の変数が無いことにより，このエラーが生じています。データ名や変数名が正しいか，よく確認してください。
他の原因として，データがすべてNA，群分け変数（d1$future）にNAが含まれるなどの場合もあります。変数（d1$tekiou や d1$future）の中身を確認してください。
スクリプトにエラーはなくても，同じスクリプトを複数回実行するとエラーの原因をつくることもあります。スクリプトを先頭から実行しなおして下さい。

55

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

作成した覚えのない変数が存在する
データファイルで，想定範囲外の列のセルに何らかのデータをRで読み込んだときそのような列に対してRは自動で X, X.1, X.2, X.3 のような変数名をつけます。また，データファイルに同じ変数名が複数あるときも，同様の番号づけを行います。
X, X.1, X.2, X.3 のような作成した覚えのない変数がR上でできているときは，重複している変数名があればそれらを修正してください。また，想定される範囲外のセルにデータがあると考えられるときは，範囲外の行や列について，ある程度の領域を指定して削除を実行し，不要なデータを証拠してください。

incomplete final line found by readTableHeader と表示される
Rでread.table関数を実行した際，incomplete final line found by readTableHeader というエラーが出ることがあります。主にApple社製のパソコン（Mac）を使っている場合に出るメッセージです。
変数名やファイル名に全角文字があると，このメッセージが出ることがあります。変数名やファイル名を
半角英数文字に変えてみてください。
それでもこのメッセージが出る場合は，「テキストエディット」などのエディタをまず起動し，そこから目的のCSVファイルを開いて，最終行の末尾に改行記号を入れて保存してください。詳しくは，本スクリプト集の「Excelを使わずにCSVファイルを作成する方法」の項を参照してください。

結果の数値に e-01 のような表記が付く
分析結果の出力が，例えば次のようになっているとします（重回帰分析の結果の一部です）。
Coefficients:

Estimate Std. Error t value Pr(>|t|)(Intercept) 4.497e-17 4.571e-02
0.000
1.0000stress
4.509e-01 5.361e-02
8.411 3.61e-15 ***kyoufu1.210e-01 5.048e-02
2.397
0.0173 *support-3.508e-01 4.907e-02 -7.150 1.03e-11 ***ここで，Estimate（推定値）の 4.497e-17， 4.509e-01 などの値はそれぞれ，
4.497e-17 = 4.497 × 10の-17乗 = 0.00000000000000004497 ≒ 0
4.509e-01 = 4.509 × 10のｰ1乗 = 0.4509 ≒0.45を意味します。
e は指数（exponential）のことで，そのうしろにくる数値が指数であることを表しています。もし，eのうしろが +03 となっていたら，10の3乗（×1000）ということになります。
4.497e-17 は実質的には0ですが，数学的には0ではありません。コンピュータは数値計算で解を求めるので，数学的に厳密に正しい値ではなく，このような値を出力することがあります。

パッケージが開けないパッケージはインストールできたが，library関数でそのパッケージを利用可能にしようとしても，開けないというトラブルがたまに発生します。いくつか原因が考えられますが，その１つとして，OSのアップデート（システムの更新）が未完了であることがあります。
Windowsであれば，スタートメニュー → 設定 → 更新とセキュリティ → 更新プログラムのチェック を行って，システムを最新の状態にしてください。おそらくパソコンの再起動が必要になります。OS（オペレーティングシステム）を最新の状態にして，Rを使うようにしてください。

56

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

パッケージの関数が使えないパッケージに含まれる関数を使おうとすると反応しない（そのような関数はみつからないと言われる）ことがあります。
まずは，当該のパッケージをきちんとインストールしているか，library関数でそのパッケージを使える状態にしているか，スクリプトに誤記はないかなどを確認してください。
パッケージの更新を行って下さい。Rでパッケージ → パッケージの更新 → パッケージを選択してOK を実行してください。
同じ関数名が他のパッケージにもあって，他のパッケージの関数が作動している場合があります。例えば，
semという関数は，semパッケージにもlavaanにもあります。使わないほうのパッケージを取り外すことにより，使いたいパッケージの関数を使うことができます。以下のスクリプトを実行して取り外します。
detach("package:使わないパッケージ")
これらを行っていてもパッケージの関数が使えないことがあります。そのようなときの原因の1つとして，
ユーザー名の問題が考えられます。全角文字のユーザー名だと，このようなエラーが生じることがあります。
この場合は，半角英数文字（先頭はアルファベット）のユーザーを新たに作成してください。
コントロールパネル → ユーザーアカウント → 別のアカウントの管理 → PC設定で新しいユーザーを追加 → その他のユーザーをこのPCに追加，と進んで，半角英数ユーザー名で新しいアカウントを作成してください。管理者権限をもたせることをお勧めします。
アカウントができたら，新しいユーザー名でサインインしてください。それで，パッケージも含めてRが正
常に動くなら，今後Rを使うときはそのアカウントを使ってください。
新しいアカウントでもRがうまく動かないときは，いったんRをアンインストールしてください。
コントロールパネル → プログラム → プログラムのアンインストール ，と進んで，Rを選んでクリックします。アンインストールするか聞いて来たら，指示に従ってアンインストールしてください。
そして，新しいアカウントを使って，Rおよびパッケージをインストールしてください。パッケージの更新，もやってください。それでパッケージも含めてRが正常に動くなら，今後Rを使うときはそのアカウントを使ってください。

57

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

エラーが発生したときの対処
スクリプトを実行してエラーが発生するときは，ほとんどの場合，スクリプトに何らかの誤りがあります。
また，Rが全然動かない（エラーすら出ない）ということも時々起こります。このような状態について，よくある誤りと対処法を説明します。なお，ある程度修正を試みてもうまくいかないときは，修正を繰り返すよ
りも，スクリプトをすべて新しく書き直したほうが早いです。

半角ｶﾅ文字を使っていませんか？
半角ｶﾅ文字は特殊な文字なので，Rのように世界中で使われるソフトには不向きです。データ，変数名，ファイル名，フォルダ名，ユーザ名等のすべていおいて，使わないで下さい。

お使いのPCのOSは何ですか？
本スクリプト集は主としてWindowsマシンを前提に書かれています。MacのパソコンでＲを使用する場合には，作業ディレクトリを設定する方法や，read.table関数でCSVファイルを読み込む方法などが異なります。
具体的な方法は，本スクリプト集の「Mac OSでＲを使用するときの注意点」の項を参照してください。

エクセルでデータを保存したCSVデータと，Rでの読み込み形式は合っていますか？
コンピュータが数値，文字，記号を認識するためには，文字コードというものが必要になります。文字コ
ードには，Shift JIS や UTF-8など，いくつか種類があります。
エクセルで「CSV (コンマ区切り)(*.csv)」で保存した場合は，文字コードは Shift JIS になります。このデータをRで読み込むには，
d1 <- read.table("dta1.csv", header=TRUE, sep=",", file=Encoding="shift-jis")とします。
エクセルで「CSV UTF-8 (コンマ区切り)(*.csv)」で保存した場合は，文字コードは UTF-8 になります。
このデータをRで読み込むには，
d1 <- read.table("dta1.csv", header=TRUE, sep=",")とします。fileEncoding オプションは不要です。Rは，ver.4.2からUTF-8を標準採用するようになりました。
どちらもうまく行かない場合は，CSVファイルにBOMというものがついている可能性が考えられます。BOMは「バイトオーダーマーク」というもので，データの先頭に，文字コードがUTF-8であることを意味する記号が付加されます。このデータをRで読み込むには，
d1 <- read.table("dta1.csv", header=TRUE, sep=",", fileEncoding="UTF-8-BOM")とします。
本スクリプト集の「データの読み込み」の項も参照してください。

作業メモリ上に余計なデータが保存されていませんか？
Rでは，計算や分析の結果を作業メモリ上に「オブジェクト」として置いておき，再利用することができます。スクリプトにエラーがあるのに，同名の古いオブジェクトが残っていると，過去の結果が使われて，ミスに気づかないことがあります。また，新しく分析結果を保存したいのに，古い分析結果の後ろに新しい分析結果が追加されてしまうこもあります。
これらの事態を避けるために，分析を始めるときは，いったんメモリ上のオブジェクトを消去しておきます。メモリを消去するには，以下のスクリプトを実行します。
rm(list=ls())
rmはメモリ消去をする関数，ls()はメモリ上にあるすべてのオブジェクト名を返す関数です。

実行するスクリプトの範囲選択は正しいですか？
スクリプト全体を実行する場合は，スクリプト画面上でマウスを右クリックし，「全て選択」を選択→「カーソル行または選択中のRコードを実行」を選択，で実行できます。
58

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

選択した範囲のスクリプトだけを実行する場合は，マウスの左ボタンを押しながら範囲を選択して左ボタンを放し，スクリプト画面上でマウスを右クリックして「カーソル行または選択中のRコードを実行」を選択，で実行できます。
ここで，実行範囲を適切に選択しないと，エラーが生じます。行の途中から範囲指定する，最後のカッコを入れてないなどです。また，最後の改行を含んでいないため，最後の行が実行されないということもよくあります。範囲指定するときは，最後の行の次の行（空白行）まで範囲指定するようにします。
例）
setwd("D:\\Report\\") を選択すべきところを setwd("D:\\Report\\"# 末尾の ) と 改行 が含まれていない

データのあるフォルダを正しく設定していますか？
データを読み込めないときによくあるエラーとして，setwd()の指定がうまくできていないことがあります。
データの入っているドライブ名（c,d,eなど）と，フォルダ名（Reportなど）を正しく指定して下さい。ドラ
イブ名の後ろは :（コロン），フォルダ名の後ろは \\（円マークを２つ）を入れるのを忘れないでください。
カッコ内全体をダブルクオーテーションで囲うのも忘れないでください。なお，フォルダ名は，Windowsであればエクスプローラで確認することができます。
例）
データファイルが，USBメモリのReportというフォルダに入っていて，USBがDドライブの場合
setwd("D:\\Report\\")#「D」は「d」でも構いません。

データファイル名は正しいですか？
データを読み込めないときよくある別のエラーとして，read.table()でファイル名が正しく書かれていな
いことがあります。ファイル名がdata1.csvのときに，データを読み込むスクリプトは次のようになります。
d1 <- read.table("data1.csv", header=TRUE, sep=",", fileEncoding="shift-jis")
なお，ファイル名については，「良くある質問・エラー」の『データが読み込めない』の項も参照してください。

変数名を間違えていませんか？
データファイル（CSVファイル）で指定した変数名と，Rのスクリプトで書いている変数名が一致しないとエラーになります。変数名を確認し，正しい変数名を書いてください。
Rにおいて，read.table()など関数と呼ばれるものは綴りが決まっていますが，変数名やデータ名は自分で綴りを指定します。これらはなるべく英数半角文字で書くことをお勧めします。ただし，先頭に数字を使うことはできません。

データファイルの変数名にスペースが入っていませんか？
データファイルの変数名に半角スペース，全角スペースがあるとき，Rでは「.」（半角ピリオド）に変換されます。あまり好ましくないので，変数名にスペースを入れるべきではありません。
また，データファイルで変数名が無い場合（予想外のセルにデータが入っている場合など），Rは自動的に
X, X.1, X.2, X.3 のような変数名をつけます。
例）
X 1 が X.1

全角記号が混ざっていませんか？
Rは全角文字と半角文字を区別します。しかし，スクリプト画面では，とくに英数字やスペースについて，
全角文字と半角文字の見分けがつきにくくなっています。それゆえ，半角で書かなければならないところが全角になっているのに気がつかず，エラーとなることがしばしばあります。
例）
d1 <- を d1 <# d1の後ろが全角スペースになっている
59

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部<- を＜－# 代入記号（半角<-）が全角になっている
x1 を ｘ１# 半角x1 を全角ｘ１にしている。
d1[d1$class=="A",] を d1[d1$class=="A",」# 最後の ] が」になっている

スペルミスをしていませんか？
スペルミスがあれば，エラーになるか，正しく動きません。
例）
x1 を xl# 1（いち）と l（エル）を間違えている
colnames を colname# sをつけ忘れている

スクリプトを書くときに「>」「+」「1:」などを左端に書いていませんか？
スクリプトを実行すると，コンソール画面には，実行されたスクリプトが表示されます。その際，左端に「>」「+」「1:」などの記号が付加されます。コンソール画面の出力を参考にしてスクリプトを書く場合，左端のこれらの記号は，スクリプトには書かないようにする必要があります。

大文字と小文字を間違えていませんか？
変数名や関数名で大文字と小文字を間違えても，エラーになります。
（ドライブ名，フォルダ名，ファイル名は，大文字小文字の区別はありません。）
例）
rowSums を rowsums
TRUE を True

記号を間違えていませんか？
$マーク，論理式，数式，などの記号を間違えると，エラーや計算間違いとなります。
例）
d1[d1$class=="A",] を d1[d1%class=="A",]# $ を % としている
d1[d1$sex=="f",] を d1[d1$sex="f",]# == を = としている<- を <または <=# 代入記号「<-」を，大小関係を表す「<」や「<=」としている

カンマを忘れていませんか？
配列の行と列の区切り，変数や関数のオプションを複数指定するときなどは，要素間をカンマで区切りらなければなりません。
例）
d1[d1$class=="A",] を d1[d1$class=="A"]table(d1$x1, d1$x2) を table(d1$x1 d1$x2)
c(x1, x2, x3) を c(x1 x2 x3)

カンマを多く入れていませんか？
余計なカンマが入っていても，エラーになります。
例）
table(d1$class, d1$grade) を table(d1$class,, d1$grade)

カンマとピリオドを間違えていませんか？
カンマを打つべきところをピリオドにすると，エラーになります。逆も同様です。
60

名古屋 大学例）
ylim=c(1.5, 2.5) を ylim=c(1.5. 2.5)
ylim=c(1.5, 2.5) を ylim=c(1,5, 2.5)

大 学院 教育発 達科 学研 究科・ 教育 学部# 1.5 の後ろのカンマをピリオドにしている# 1.5 と書くべきところを 1 カンマ 5 としている

文字列をダブルクォーテーションで囲うのを忘れていませんか？
変数名，ファイル名，記号などの文字列は " " で囲います。片方または両方を付け忘れると，エラーになります。
例）("D:\\Report\\") を ("D:\\Rreport\\)"data1.csv" を data1.csv=="A" を ==A# 「"A"」はAという文字，「A」はAという変数の意味になります。

カッコをつけ忘れていませんか？
開くカッコに対して，必ず閉じるカッコがなければなりません。
例）round(data.frame(n.d1, mean.d1),2) を round(data.frame(n.d1, mean.d1, 2)# 開くカッコが2つあるのに，閉じるカッコが1つしかない

カッコの種類を間違えていませんか？
Rはカッコの種類を区別します。開くカッコと閉じるカッコは，同じ種類でなければなりません。
例）
d1[,items] を d1[,items)

カッコで括らなければならないのを忘れていませんか？
if文の条件式はカッコで括らなければなりません。また，計算結果を代入値として使いたいときに，計算部分をカッコで括らなければならないことがあります。
開くカッコと閉じるカッコが同じ行にないとエラーになる場合があります。その場合は，長い文になっても，途中で改行せす１行のままにしておく必要があります。
例）
if (x==5) を if x==5
xlim=c((xmin - .5), (xmax + .5)) を xlim=c(xmin - .5, xmax + .5)
for(i in 1:(n+3)) を for(i in 1:n+3)

カッコをつける位置を間違えていませんか？
開くカッコと閉じるカッコの数があっていても，つける位置が間違っていると，エラーになったり，意図とは異なる結果になったりします。
例）floor(round(24.5)+0.5) を floor(round(24.5+)0.5)# エラーになる
floor(round(24.5)+0.5) を floor(round(24.5+0.5))# 異なる結果になる

オプションは正しく書かれていますか？
header=TRUEなどオプションと言われるものに誤りがある場合，Rは関数によって，エラーを出すか，間違いのあるオプションを無視します。
エラーが表示される場合はそこで止まりますので，間違いを修正します。
無視される場合は，何も言わずに以前の分析結果を表示することがありますので，オプションを変えても結果が変わらない場合は，オプション指定に誤りがあることに自分で気がつく必要があります。
61

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Rのヘルプを使って，関数の書式やオプションの指定法などを調べるのも有効な方法です。ヘルプの使い方については，本スクリプト集の「ヘルプの使い方」の項を参照してください。なお，パッケージに含まれている関数は，そのパッケージをlibrary()で呼び出してからでないと，ヘルプをみることができません。

if - else文を書くとき，if 文の終わりと else 文の始まりの間で改行してませんか？
if - else文 では，else文はif文の終わりと同じ行に書かなくてはなりません。
例）
if (x==5){y <- 1} else y <- 0 を
if (x==5){y <- 1}
else y <- 0

１行に複数の命令文を書いていませんか？
プログラムを書くとき，１つの行に複数の命令文を続けて書くことはできません。コンピュータには，どこが文の切れ目か分からないからです。どうしても１行に複数の命令文を書きたいときは，セミコロン「;」で区切りるようにします。
例）
head(d1)nrow(d1)
を
head(d1) nrow(d1)# head(d1); nrow(d1) ならOK

１つの数式を複数行に分けて書くとき，次の行の先頭が+ - * / などの記号になっていませんか？
数式をの途中で改行するとき，改行した次の行の先頭が + - * / などになっているとエラーになることがあります。

パッケージは正しくインストールされていますか？
library()でパッケージを呼び出す際，パッケージがインストールされていないと呼び出すことはできません。パッケージを利用する際は，あらかじめインストールしておく必要があります。本スクリプト集の「パッケージのインストール」の項などを参照して，パッケージをインストールしてください。
パッケージのインストールは，Rをインストールした後に1回行えば，あとは何度でも利用できます。ただし，異なるバージョンのRをインストールした場合は，パッケージも改めてインストールする必要があります。
なお，パッケージをインストールしたはずなのに，library()でパッケージを開けないことがあります。これは，パッケージをインストールするとき，Rが自動的に指定するフォルダの不具合で，通常とは異なるディレクトリにパッケージがインストールされるためです。この場合は，Rのインストールからやり直すと解決することが多いです。

R Studioを使っていませんか？
R Studioを使っている場合，まれに原因不明のエラーが生じます。他にエラーの原因が思い当たらない場
合は，R Studioは使わずに，R本体を起動してRを実行してください。

Rが複数個，起動していませんか？
Rが複数個起動していて，いま操作していない別のRが何かの待ち状態になっていると，いま操作しているRも動かないことがあります。
Rが複数個起動していることは，画面のタスクバーに複数個のRのタブがあることなどで確認できます。こ62

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

れが原因でRが動かないときは，いま操作していない別のRの待ち状態を解消するか終了して下さい。

コンピュータが再起動待ちの状態になっていませんか？
コンピュータを使っている間に，システムの自動アップデートなどが行われて，コンピュータの再起動待ち状態になっていると，Rが動かないことがあります。
この場合は，Rを含めすべてのプログラムを終了して，コンピュータを再起動してシステムのアップデートを行ってから，Rを再度実行してください。システムの再起動後，システムの更新版のチェックを行って，最新の状態にしてからRを実行することをお勧めします。

全角文字を使っていることが原因のこともあります
全角文字に対応していない関数を使う場合などは，半角ｶﾅだけでなく，全角文字もエラーの原因となります。スペルミスなど，他に思い当たる原因がない場合は，これが原因になっている可能性があります。データ，変数名等を半角英数文字にしてください。

パソコンのユーザー名が全角文字になっていることが原因のこともあります
パソコンのユーザー名が全角文字だと，エラーが出る，または，動かない関数があります。この場合は，管理者権限のある半角英数文字のユーザーアカウントを作成し，そのアカウントでパソコンにサインインして，Rを使ってください。

Rやコンピュータを再起動することも有効です
再起動待ちでもなく，原因は分からないけどとにかくRが動かなくなったという場合も，Rを終了して再起動，コンピュータを再起動などすることにより，動くことがあります。

Rを再インストールすることも有効です
何をやってもエラーが出るという場合，Rを再インストールしたら解決したという事例も，パッケージを利用する場合などに，まれにあります。

63名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Exceにおけるデータファイルの作成

Excelなどを使ってデータを入力する。
setwd で指定する作業ディレクトリにデータファイルを置いておくのがわかりやすくてよい．
１行目に変数名を入れておく．x1，x2のようなものでもよいし，stress, support, のように内容がわかる
ような変数名でもいい．
１列目にはidを入れておくと，入力ミスの検索や質問紙との照合などに役立つ．id変数の変数名を大文字で「ID」としないほうが無難である．
和文フォントも使えないわけではないが，ときどきRで問題がおきるので，英文フォントにしておいたほうが無難．（Rは世界中のボランティアが開発しているソフトなので，言語のローカル性を考慮していない追加
オプションが存在する可能性がある）
欠測の場合は空白セルにしておくとよい（Rで読み込むと自動的にNAとなるが，最初からNAと入れるよりは，
空白にしておいたほうがよい）．

64

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Excelを使わずにCSVファイルを作成
Excelを使わずにCSVファイルを作成したい場合，たとえば，「メモ帳」や「テキストエディット」などを使ってデータをCSV保存する方法があります。
Windowsの場合，まずWindowsアクセサリーからメモ帳を開き，データを「半角カンマ」で区切って入力します。Macの場合はテキストエディットを用います。
最終行まで入力したら，さらに改行し，カーソルを最終行の下に移動させます。
ファイル → 名前を付けて保存 → ファイルを保存するフォルダを選択 → ファイル名に「data1.csv」な
どと入力 → ファイルの種類を「すべてのファイル」に変更 → 文字コードを「ANSI」に変更 → 保存 とします。
これで，指定したフォルダにCSVデータファイルが保存されるはずです。
CSVは「comma separated value」の略なので，テキストエディタと言われるもの（メモ帳など）で，デー
タを半角カンマで区切って入力し，ファイル名を「○○.csv」として保存すれば，Excelを使わなくても作成
できます。

65

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ExceにおけるデータファイルのCSV保存
データはCSV形式で保存しておくのが汎用性が高くてよい。
ExcelでCSV保存する際，2通りの文字コードがある。どちらにも長短があるので，使いやすさなどを考えて，自分が良いと思うほうのCSVファイルで保存する。
【重要】本スクリプト集では，CSV (コンマ区切り)(*.csv) で保存した Shift JIS コードのcsvファイルを前提として記載する。
read.table, write.table において，fileEncoding="shift-jis" を付ける。

CSV (コンマ区切り)(*.csv)で保存した場合
文字コード：Shift JIS
MicroSoft社が開発したコードで，日本国内のソフトであれば不自由を感じることはまずないが，外国製のソフトでは文字化けすることがある。
日本語環境のRで読み込むときに，encoding= というオプションを付ける必要がない。
Excelで保存した場合，「BOMなし」のcsvファイルになり，Rで読み込んだとき，第1変数の変数名に余計な記号が付くことはない。

CSV UTF-8(コンマ区切り)(*.csv)で保存した場合
文字コード：UTF-8 コード
世界中で普及しているコードなので，多くのソフトが対応しており，外国製のソフトでも文字化けする可能性が低い。
日本語環境のRで読み込むときは，encoding="UTF-8" というオプションを付けなければならない。
Excelで保存した場合は「BOM付き」というcsvファイルになり，Rで読み込んだとき，第1変数の変数名に余計な記号が付く場合がある。元の変数名に戻すには，colnames 関数を使って変数名を修正する。

CSV UTF-8(コンマ区切り)(*.csv)

CSV (コンマ区切り)(*.csv)
66

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

作業ディレクトリの指定
setwd("ドライブ名\\フォルダ名\\…\\")「f:\\data\\」 のように「\」マーク（画面上では「＼」になることも多い）を２つずつ入れて区切る．
指定したディレクトリを「"」で囲む．
Windowsでは，\\の代わりに /（スラッシュ）を1つ書いて「f:/data/」とすることもできる．
Mac の場合は，ディレクトリの指定の仕方が異なるので注意（「Mac版のＲで作業ディレクトリを設定する
方法」参照）。

> #データファイルがあるフォルダの指定> setwd("d:\\")>
setwd を実行しておくと，「ファイル」→「（別名で）保存」などとしたとき，setwdで指定されたディレクトリが最初から表示される．
データフレームの保存（後述）もsetwdで作業
ディレクトリを指定してあれば，その場所に保存される．

setwd を実行していないと，「ファイル」→「（別名で）保存」などとしたとき，個人のドキュメ
ントファイルディレクトリが表示される．ファイルを保存すべきドライブ\\フォルダ\\まで，
いちいち移動しなければならない．

67

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

データの読み込みCSV (コンマ区切り)(*.csv)の場合（Shift JIS コード）
データフレーム名 <- read.table("ファイル名.csv", header=TRUE, sep=",", fileEncoding="shift-jis")
CSV UTF-8(コンマ区切り)(*.csv)の場合（UTF-8コード）
データフレーム名 <- read.table("ファイル名.csv", header=TRUE, sep=",")
header=TRUE：1行目に変数名があるという指定
sep=","： データはカンマ区切りのテキストファイル（つまりCSV形式）という指定
Shift-JISコードの場合は，fileEncoding="shift-jis" というオプションをつける．
【重要】 全角文字を使わなければ，fileEncodingオプションは不要であるが，ExcelがShift-JISコードである間は，
とにかく fileEncoding="shift-jis" を付けておいたほうが無難。
ある列の値を行名に設定したいときは，row.names="変数名" または 列番号 とする．
変数名（header）が１セル左にずれたデータを読み込むと，１列目のデータが自動的に行名になる．
Mac の場合は，ディレクトリの指定の仕方が異なるので注意（「Mac OSでＲを使用するときの注意点」参照）。
read.csv という関数や，Excelファイルを読み込む関数などもある．

> setwd("d:\\")>> # Shift JIS 形式のcsvファイルを読み込む> d1 <- read.table("データ例2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> #最初の数行を表示> head(d1)
1
2
3
4
5
6
>

id x1 x2x3 x4
1 23 a 心理 ア
2 18 b 教育 ア
3 15 a 医学 ウ
4 12 c 看護 ウ
5 5 b 看護 イ
6 14 b 心理 エ

> #UTF-8形式のCSVファイルを読み込む> d2 <- read.table("データ例UTF8.csv", header=TRUE, sep=",")> head(d2)
1
2
3
4
5
6

id x1 x2x3 x4
1 23 a 心理 ア
2 18 b 教育 ア
3 15 a 医学 ウ
4 12 c 看護 ウ
5 5 b 看護 イ
6 14 b 心理 エ68名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 変数名が１セル左にずれたデータの読み込み> d4 <- read.table("データ例_rowあり.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d4)
１列目が行番号のデータ
x1 x2
x3 x4
変数名が１セル左にずれている
1 23 a 心理 ア
2 18 b 教育 ア
3 15 a 医学 ウ
4 12 c 看護 ウ
5 5 b 看護 イ
6 14 b 心理 エ

> # write.table で row.names=TRUE にした場合，１行目に変数名，１列目に行名が保存されるが，> # 行名に対する変数名は無いため，変数名が１セル左にずれて保存される．
> # このようなデータを読み込んだ場合，１行目にある変数名は自動的に右にずれて２列目以降の変数名> # になる。（ズレが自動的に解消される）> # ある列のデータをを行名にした読み込み> p.all <- read.table("irt_項目パラメタデータ.csv",>
row.names="item", header=TRUE, sep=",", fileEncoding="shift-jis")> p.allaj
bj cj
s03 0.7519081 -1.3479054 0
s04 0.6336668 -2.6447011 0
s05 1.2141256 -1.0870115 0
s06 1.4940753 -0.9263137 0
s07 1.7233574 -1.7290162 0
s08 0.9815908 3.1497698 0
s09 1.0866067 -0.3036178 0
s12 1.4498429 -0.1380151 0
s14 1.0159834 -0.2558882 0
s15 0.9046749 -0.4216555 0
s16 1.4752955 0.2216158 0# item 列の値が行名になっている> p.all[1,1][1] 0.7519081> # p.allというデータの(1,1)要素は0.75… であり，s03ではない．s03は1行目に付けられた行名

69

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

読み込んだデータの確認
head(データフレーム名)
データフレームの最初の6行を表示する．
n=10 などど行数を指定するオプションを付けることもできる．

> setwd("d:\\")>> d1 <- read.table("データ例2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> # 最初の数行を表示> head(d1)
id x1 x2x3 x4
1 1 23 a 心理 ア
2 2 18 b 教育 ア
3 3 15 a 医学 ウ
4 4 12 c 看護 ウ
5 5 5 b 看護 イ
6 6 14 b 心理 エ

> # データの行数> nrow(d1)[1] 10> # データの列数> ncol(d1)[1] 5> # 変数名> colnames(d1)[1] "id" "x1" "x2" "x3" "x4">70

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

R上のデータのCSV保存
SHIFT JIS CSVファイルとして保存
write.table(データ名, "ファイル名.csv", row.names=FALSE, sep=",", fileEncoding="shift-jis")row.names=FALSE にしておくと，行名は保存されない．
sep="," でデータをカンマ区切りのテキストファイル（つまりCSV形式）で出力する指定をしている．
fileEncoding="shift-jis" でShift-JISコードで保存される。Excelで文字化けせずに開ける。
setwd で作業ディレクトリを設定していない場合は，意に反したディレクトリに保存されることもある．

> setwd("d:\\")>> d1 <- read.table("データ例2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> head(d1)
id x1 x2x3 x4
1 1 23 a 心理 ア
2 2 18 b 教育 ア
3 3 15 a 医学 ウ
4 4 12 c 看護 ウ
5 5 5 b 看護 イ
6 6 14 b 心理 エ
> #分析に必要な変数だけを取り出す> d2 <- d1[,c("x1","x2","x3","x4")]>> head(d2)
x1 x2
x3 x4
1 23 a 心理 ア
2 18 b 教育 ア
3 15 a 医学 ウ
4 12 c 看護 ウ
5 5 b 看護 イ
6 14 b 心理 エ

# id変数が削除されている．
# d2 <- d1[,c(-1)] としても同じ．c(-1)は「1列目は削除」を意味する> # データの保存> # row.names=FALSEの場合> write.table(d2, "データ例2_rowなし.csv", row.names=FALSE, sep=",", fileEncoding="shift-jis")> # row.names=TRUEの場合> write.table(d2, "データ例2_rowあり.csv", row.names=TRUE, sep=",", fileEncoding="shift-jis")
新たに保存したファイル
行番号なし
変数名とデータの列が一致

行番号あり
１列目は行番号．変数名が１セル左にずれる．

71

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

UTF-8 CSVファイルとして保存
write.table(データフレーム名, "ファイル名.csv", row.names=FALSE, sep=",")> setwd("d:\\")>> d1 <- read.table("データ例2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> head(d1)
id x1 x2x3 x4
1 1 23 a 心理 ア
2 2 18 b 教育 ア
3 3 15 a 医学 ウ
4 4 12 c 看護 ウ
5 5 5 b 看護 イ
6 6 14 b 心理 エ>
> #分析に必要な変数だけを取り出す> d2 <- d1[,c("x1","x2","x3","x4")]>> head(d2)
x1 x2
x3 x4
1 23 a 心理 ア
2 18 b 教育 ア
3 15 a 医学 ウ
4 12 c 看護 ウ
5 5 b 看護 イ
6 14 b 心理 エ

# id変数が削除されている．
# d2 <- d1[,c(-1)] としても同じ．c(-1)は「1列目は削除」を意味する> # UTF-8 CSVファイルとして保存> write.table(d2, "データ例2_UTF8.csv", row.names=FALSE, sep=",")# Excelで開くと全角文字が文字化けする

72

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

UTF-8 CSVファイルをExcelで読み込む方法
Excelを起動する→ 空白のブック→ データ→ テキストファイル→ 目的のファイルを選択して→ インポート→ 元のファイル」65001：Unicode(UTF-8)→ 次へ→ 「区切り文字」でコンマにチェック
→ 次へ
→ 完了
→ OK
文字化けしないでデータが読み込まれる。これを保存すれば次からはExcelではきちんと読み込める73

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Excel形式データファイルの読み込み・保存
Excel形式（xlsx）で保存したデータをCSVに変換せず，Excel形式のままRで読み込むことも可能である。
library("openxlsx")
データフレーム名 <- read.xlsx("Excelファイル名.xlsx")【重要！】あらかじめopenxlsxパッケージをインストールしておく必要がある。
CSV形式のファイルを読み込んだ場合，文字変数の空白セルは「空白」というデータとして認識される。
ExcelV形式のファイルを読み込んだ場合，文字変数の空白セルは欠測データとして認識される。
例えば，多枝選択における複数選択問題など，「,」(カンマ)を含むデータを読み込む場合は，CSV形式だと文字変数の欠測値の指定が必要になるが，Excel形式であれば，欠測値の指定をしなくても，空白セルを欠測値として読み込む。

CSVデータExcel(xlsx)データ

Excelで，CSVデータとExcelデータをを開いた場合，見かけ上は同じである。

CSVデータをメモ帳で開いた場合

CSVデータをメモ帳で開くと，「,」（カンマ）を含むデータは「""」で囲まれていることが分かる。

74

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> rm(list=ls())>> setwd("d:\\Rreports\\")>> # CSVデータの読み込み> (d1 <- read.table("複数回答データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis"))id School Grade X1X2 X3 X4
1
1
A
1 C
A 1
1
2
2
A
2 C
B 2
2
3
3
A
2 C
C 3
3
4
4
A
3 A
A,B 4
4
5
5
A
1 C
A,C NA 1,2
6
6
B
2 B
B,C 2 1,3
7
7B
2 C A,B,C 3 1,4
8
8
B
1 D
2 3,4
9
9
B
3 C
A 1 2,3
10 10
B
1 C
B 2
>

# 文字変数の空白は「空白」データ，# 数値変数の空白は欠測値になっている。

> # パッケージの読み込み> library("openxlsx")>> # Excelデータの読み込み> (d2 <- read.xlsx("複数回答データ.xlsx"))
id School Grade X1
X2 X3
X4
1
1
A
1 C
A 1
1
2
2
A
2 C
B 2
2
3
3
A
2 C
C 3
3
4
4
A
3 A
A,B 4
4
5
5
A
1 C
A,C NA 1,2
6
6
B
2 B
B,C 2 1,3
7
7B
2 C A,B,C 3 1,488B
1 D <NA> 2 3,4
9
9
B
3 C
A 1 2,3
10 10
B
1 C
B 2 <NA>># 文字変数も数値変数も，空白は欠測値になっている> # 文字変数における空白セルの扱いの確認> table(d1$X2, useNA="ifany")

>

1

A
2

A,B A,B,C
1
1

A,C
1

B
2

B,C
1

C
1

B,C
1

C
1

<NA>
1

> table(d2$X2, useNA="ifany")A
2

A,B A,B,C
1
1

A,C
1

B
2

>
> # CSVファイル保存> write.table(d1, "複数回答データ_R.csv", row.names=FALSE, sep=",", fileEncoding="shift-jis")> # Excelファイル保存> write.xlsx(d2, "複数回答データ_R.xlsx")>75

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

複数回答データ_R.csv

CSV形式で保存した場合，文字変数の空白は「空白」データ，数値変数の欠測は「NA」という文字列として保存される。

複数回答データ_R.xlsx

Excel形式で保存した場合，文字変数および数値変数の欠測は「空白」データとして保存される。

76

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

欠測値の取り扱い
CSVデータにおいて，欠測値は空白セルにしておく．それをRで読み込むと自動的にNA（Not Available）となる．

文字列データにおける空白を欠測値とする
na.strings=""
データ読み込み時，read.tableのオプションに na.strings="" と書いて設定する。
そうしないと，空白も1つのカテゴリとして認識してしまう。

> d1 <- read.table("欠測値文字データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 性別
学科 x1 x2 x3
1
1
看護学 3 2 4
2
2
男
3 2 3
3
3
女
医学 NA 3 14
4
女 看護学 3 4 1
55男
医学 1 3 36
6
女 心理学 2 1 3> d1$性別 <- as.factor(d1$性別)> levels(d1$性別)[1] """女" "男"# na.strings="" がないので，空白も1つのカテゴリとして認識されている>>> d1 <- read.table("欠測値文字データ.csv", header=TRUE, sep=",", na.strings="",>fileEncoding="shift-jis")> head(d1)
番号 性別
学科 x1 x2 x3
1
1 <NA> 看護学 3 2 422
男<NA> 3 2 3
33女
医学 NA 3 14
4
女 看護学 3 4 1
55男
医学 1 3 36
6
女 心理学 2 1 3> d1$性別 <- as.factor(d1$性別)> levels(d1$性別)[1] "女" "男"# na.strings="" があるので，空白は欠測値として認識されているデータの各要素が欠測値か否かを確認する
is.na(データ)
当該要素が欠測値ならTRUE，欠測値でなければFALSEという値を返す．
データには，データフレーム，ベクトル，及び，それらの要素を指定することができる．

if 文，ifelse文での欠測値の扱い
if( is.na(データ) != TRUE ){ if(条件式) }ifelse( is.na(データ), …, …)
データに欠測値があるとき，「データ==…」の評価結果は，TRUEでもFALSEでもなくNAとなり，
if文やifelse文がエラーとなる．
例えば，不等式 x1 < 1 を評価するとき，x1がNAの場合，x1 < 1 はTRUEになってしまうことがある。
そこで，is.na(データ)でNAかどうかを評価して，TRUEまたはFALSEを返して，先に進む．

77

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

どの行に欠測値があるかを確認する
complete.cases(データフレーム名)
欠測値がない行はTRUE，欠測値がある行はFALSEという値を返す．

欠測値があることを許さない関数を使う場合
データフレーム名 <- na.omit(データフレーム名)
欠測値のある行を取り除いたデータフレームを作成して関数に入れる．

欠測値の除外をオプションで指定できる関数の場合
関数(…, na.rm=TRUE)
関数(…, use="pairwise.complete.obs")
na.rm=TURE とすると，当該変数において，欠測値のある行は除外して計算する．すべての関数で必要な訳でもないが（自動的に欠測値のある行を除外する関数もある），na.rm が効かない関数もある．
cov や cor 関数では，use オプションで指定する．
use: "everything"
当該2変数に欠測値がある場合，その箇所の値だけNAとなる"complete.obs"
1つでも欠測値のある行を除外してすべての値を計算"pairwise.complete.obs" 当該2変数に欠測値がある場合，その箇所だけ欠測値を除外して計算> setwd("d:\\")> d1 <- read.table("欠測データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1
x1 x2 x3 x4
1 NA 3 2 32
3 3 2 33
3 3 2 14
3 3 2 25
3 1 2 36
2 3 3 37
2 3 2 38
3 2 2 39
3 3 2 210 2 2 2 1
11 3 3 2 2
12 2 3 2 1
13 1 3 2 314 2 3 2 1
15 NA NA 2 2# 1行目のx1，15行目のx1，x2に欠測値がある>>> # 各要素欠測値かどうかの確認> is.na(d1)
x1
x2
x3
x4
[1,] TRUE FALSE FALSE FALSE[2,] FALSE FALSE FALSE FALSE[3,] FALSE FALSE FALSE FALSE[4,] FALSE FALSE FALSE FALSE[5,] FALSE FALSE FALSE FALSE[6,] FALSE FALSE FALSE FALSE# 1行目のx1，20行目のx1，x2に欠測値があることがわかる

78

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

TRUE

TRUE

[7,] FALSE FALSE FALSE FALSE[8,] FALSE FALSE FALSE FALSE[9,] FALSE FALSE FALSE FALSE[10,] FALSE FALSE FALSE FALSE[11,] FALSE FALSE FALSE FALSE[12,] FALSE FALSE FALSE FALSE[13,] FALSE FALSE FALSE FALSE[14,] FALSE FALSE FALSE FALSE[15,] TRUE TRUE FALSE FALSE>>> #欠測値のある行の確認> complete.cases(d1)[1] FALSE TRUE TRUE TRUE
[13] TRUE TRUE FALSE
>
>

TRUE

TRUE

TRUE

TRUE

TRUE

TRUE

# 1行目と20行目がFALSEになっており，欠測値があることがわかる> # 欠測値のある行を削除したデータフレームの作成> d2 <- na.omit(d1)> d2
x1 x2 x3 x42
3 3 2 33
3 3 2 14
3 3 2 25
3 1 2 36
2 3 3 37
2 3 2 38
3 2 2 39
3 3 2 210 2 2 2 1
11 3 3 2 2
12 2 3 2 1
13 1 3 2 314 2 3 2 1# d1から1行目と15行目が削除されている>>> # 平均値> #欠測値を除外しない場合> round(colMeans(d1),2)
x1
x2
x3
x4
NA
NA 2.07 2.20>

> #当該変数において，欠測値を除外した場合> round(colMeans(d1, na.rm=TRUE),2)
x1
x2
x3
x4
2.46 2.71 2.07 2.20>

> # 欠測値のある行を削除した場合> round(colMeans(d2),2)
x1
x2
x3
x4
2.46 2.69 2.08 2.15>>

# 欠測値のある変数の平均は計算されない# 変数ごとに，欠測値を除外して平均値を計算# 1つでも欠測値のある行を削除してしまったので，# x3，x4の平均値も変わってしまう79名古屋 大学> # 相関係数行列> #欠測値を除外しない場合> round(cor(d1),2)
x1 x2
x3
x4
x1 1 NANA
NA
x2 NA 1NANA
x3 NA NA 1.00 0.26
x4 NA NA 0.26 1.00>

# 欠測値のある変数の相関係数は計算されない> # 当該変数において，欠測値を除外した場合> round(cor(d1, use="pairwise.complete.obs"),2)
x1
x2
x3
x4
x1 1.00 -0.23 -0.21 0.01
x2 -0.23 1.00 0.13 -0.16
x3 -0.21 0.13 1.00 0.26
x4 0.01 -0.16 0.26 1.00>

# 変数ペアごとに欠測値を除外して相関係数を計算> # 欠測値のある行を削除した場合> round(cor(d1, use="complete.obs"),2)
x1
x2
x3
x4
x1 1.00 -0.23 -0.21 0.01
x2 -0.23 1.00 0.15 -0.20
x3 -0.21 0.15 1.00 0.28
x4 0.01 -0.20 0.28 1.00>

大 学院 教育発 達科 学研 究科・ 教育 学部# 1つでも欠測値のある行を削除してしまうので，# 他の相関係数の値が変わってしまう# または> round(cor(d2),2)
x1
x2
x3
x4
x1 1.00 -0.23 -0.21 0.01
x2 -0.23 1.00 0.15 -0.20
x3 -0.21 0.15 1.00 0.28
x4 0.01 -0.20 0.28 1.00

> # 度数表，クロス表> # 欠測値を無視する> table(d1$x1, d1$x4)
1 2 3
1 0 0 12 3 0 23 1 3 3>> # 欠測を常に1つのカテゴリとして扱う> table(d1$x1, d1$x4, useNA="always")
1 2 3 <NA>
1
0 0 1
0
2
3 0 2
0
3
1 3 3
0
<NA> 0 1 1
0>> # 欠測がある場合のみ1つのカテゴリとして扱う> table(d1$x1, d1$x4, useNA="ifany")
1 2 3
1
0 0 1
2
3 0 2
3
1 3 3
<NA> 0 1 180

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

データ値に基づいたカテゴリ変数の生成 ― 離散データ
各データ値に，新しくカテゴリ値を対応させる
新変数名 <- factor(元変数名, levels=c(データ値), labels=c(カテゴリ値))
levelsの各データ値に対して，labelsでカテゴリ値を付与していく。
levelsの異なるデータ値に対して，同じlabels値を与えることも可能。

> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> head(d1)
1
2
3
4
5
6

番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
20Y1 看護学
女
高
49
23 就職
2
20Y2 心理学
男
低
57
29 就職
3
20Y1
医学
女
高
42
23 進学
4
20Y1 看護学
女
高
41
23 就職
5
20Y2
医学
男
低
41
22 就職
6
20Y1 心理学
女
低
47
24 就職

> # 性別データからsexデータを作成> table(d1$性別)
女 男
143 127>> d1$sex <- factor(d1$性別, levels=c("男","女"), labels=c("M", "F"))>> table(d1$性別, d1$sex, useNA="ifany")
M
F
女
0 143
男 127
0

> # 学科データからareaデータを作成> table(d1$学科)
医学 看護学 心理学
76
100
94
>
> d1$area <- factor(d1$学科, levels=c("医学","看護学","心理学"),+labels=c("medical", "comedical", "comedical"))>> table(d1$学科, d1$area, useNA="ifany")
医学
看護学
心理学

medical comedical
76
0
0
100
0
94

>

81

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

データ値に基づいたカテゴリ変数の生成 ― 連続データの場合
連続変数データをいくつかの階級に分割して，各階級にカテゴリ値を対応させる
新変数名 <- cut(元変数名,breaks=c(分割点),right=FALSE, labels=c(カテゴリ名), ordered_result=TRUE)
分割点は，-Inf, …，Inf で指定する．
right=FALSE とすると，分割点の右端の値は含まない．TRUE（初期設定）とすると，右端の値を含む．
分割点で分割される区間分のカテゴリ名を指定する（-Inf, Infを含んだ分割点の個数 － １）．

> setwd("d:\\")> d1 <- read.table("合計得点_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id x1 x2 x3 x4 x5 x6 x7 x8
1 1 3 3 2 3 1 2 3 1
2 2 3 3 2 3 2 3 3 2
3 3 3 3 2 1 1 1 1 1
4 4 3 3 2 2 1 2 3 1
5 5 3 3 3 3 3 3 3 3
6 6 3 3 2 3 2 2 2 2>> # 変数リスト名> list.goukei <- c("x1", "x2", "x3", "x4", "x5", "x6", "x7", "x8")> # 合計得点の計算> d1$goukei <- rowSums(d1[,list.goukei])>> # 合計得点を３群に分けるカテゴリデータを生成> d1$gun <- cut(d1$goukei, breaks=c(-Inf, 14, 20, Inf), labels=c("L", "M", "H"),+ordered_result=TRUE)> #対応表の表示> table(d1$gun, d1$goukei)LMH

9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
3 5 5 7 14 13 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 11 20 30 26 19 29 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 16 22 16 12

breaks=c(-Inf, 14, 20, Inf), labels=c("L", "M", "H")でやっていること
goukei得点に基づいて，-∞ < goukei <= 14 なら gun = "L"
14 < goukei <= 20 なら gun = "M"
20 < goukei <= +∞ なら gun = "H"のようにgun変数を作成しています。table(d1$gun, d1$goukei) で，群分けが正しく行われているか，gunと goukei の関係をみて確認しています。
ordered_result=TRUE は，表などを書くとき，カテゴリの順番を L, M, H の順で表示させるための指定です。

82

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

カテゴリ変数の再カテゴリ化 ― 水準の合併
元のカテゴリの確認
levels(変数名)
元の変数はfactor型である必要がある．もしfactor型でなければ，変数名 <- as.factor(変数名) として，
factor型に変換しておく．
再カテゴリ化
levels(変数名) <- c(元のカテゴリに対応させる新しいカテゴリの並び)
元のカテゴリの並び順に，新しいカテゴリを割り当てていく．
再カテゴリ化する変数は，元の変数に上書きしてもよいし，新しい変数を作成してもよい．

> setwd("d:\\")> d1 <- read.table("カテゴリ化_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)seibetsu age
1
0 29
2
0 28
3
1 30
4
1 30
5
1 33
6
1 29
>
> #データのカテゴリ化> d1$age2 <- cut(d1$age, ,right=FALSE,+
breaks=c(-Inf,10,20,30,40,50,Inf),+labels=c("0_9","10_19","20_29","30_39","40_49","50_"))>> #カテゴリ化の結果> table(d1$age2)
0_9 10_19 20_29 30_39 40_49
0
30
132
97
11

50_
0

> #再カテゴリ化> # 元の変数のカテゴリ確認> levels(d1$age2)[1] "0_9""10_19" "20_29" "30_39" "40_49" "50_"> # 新しい変数の作成> d1$age3 <- d1$age2> # 新しい変数のカテゴリを再カテゴリ化> levels(d1$age3) <- c("nonage","nonage","adult","adult","adult","adult")>> # 再カテゴリ化の結果> table(d1$age2,d1$age3)

>

0_9
10_19
20_29
30_39
40_49
50_

nonage adult
0
0
30
0
0
132
0
97
0
11
0
0

83

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

不要な水準の削除・必要な水準の追加
as.vector(変数名)またはas.factor(as.vector(変数名))> setwd("d:\\")> d1 <- read.table("カテゴリ化_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)seibetsu age
1
0 29
2
0 28
3
1 30
4
1 30
5
1 33
6
1 29
> #データのカテゴリ化> d1$age2 <- cut(d1$age, ,right=FALSE, breaks=c(-Inf,10,20,30,40,50,Inf),+labels=c("0_9","10_19","20_29","30_39","40_49","50_"))> # 新しいカテゴリ変数の作成> d1$age3 <- d1$age2> levels(d1$age3) <- c("nonage","nonage","adult","adult","adult","adult")> # 再カテゴリ化の結果> table(d1$age2,d1$age3)
0_9
10_19
20_29
30_39
40_49
50_

nonage adult
0
0
30
0
0
132
0
97
0
11
0
0

> # adult だけのデータ> d2 <- d1[d1$age3=="adult",]> # adult だけのデータのage2の度数分布> table(d2$age2)
0_9 10_19 20_29 30_39 40_49
50_
0
0
132
97
11
0

# adult だけのデータであるから，0_9 および# 10_19 という水準はもはや不要であるが，# もとのデータの水準名を引き継いでいるため，# これらの水準が残っている> # 不要な水準の削除> # 一度ベクトル型にしてから，（必要があれば）factorに戻す> d2$age2a <- as.factor(as.vector(d2$age2))> table(d2$age2a)20_29 30_39 40_49
132
97
11

#

0_9 と 10_19，さらに度数が0だった 50_ という水準が無くなっている> # 必要な水準の追加> # 50_ というカテゴリが必要なら，levels に50_を追加する> d2$age2b <- factor(d2$age2a, levels=c("20_29","30_39","40_49","50_"))> table(d2$age2b)20_29 30_39 40_49
132
97
11

50_
0

# 50_というデータは無いが，度数 0 として認識されている

84

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

回答データの採点
採点変数 <- ifelse(正答の条件式, 点数， 誤答の点数)
最初に無回答の処理をする
誤答のところに，準正答の式を入れることも可能
正答の条件式は，複数の条件を & (and) や|(or) で設定することも可能> setwd("d:\\")> d1 <- read.table("採点データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1
id class sex x1 x2 x3 x4 x51
1
af 4 1 1 3 2
22bm 1 1 2 3 433am 2 3 4 3 444am 4 2 3 2 1
55bf 3 3 2 4 366bf 1 4 2 4 277bf NA 3 1 1 4
88am 1 2 4 2 3
99af NA NA NA NA NA
10 10bm 3 4 3 1 4>> # 採点> # スコア変数を s1などとして作成>> # x1: 1 が正答> d1$s1 <- ifelse(is.na(d1$x1), 0, ifelse(d1$x1==1, 1, 0))>> # x2: 1 が正答， 2 が準正答
> d1$s2 <- ifelse(is.na(d1$x2), 0, ifelse(d1$x2==1, 1, ifelse(d1$x2==2, 0.5, 0)))>> # x3: 1 または 4 が正答> d1$s3 <- ifelse(is.na(d1$x3), 0, ifelse((d1$x3==1 | d1$x3==4), 1, 0))>> # x4,x5: x4 が 3， かつ， x5 が 4 が正答> d1$x4_5 <- paste(d1$x4, d1$x5, sep="")> d1$s4_5 <- ifelse(d1$x4_5 == "34", 1, 0)>> # 採点結果の確認> table(d1$x1, d1$s1, useNA="always")
0 1 <NA>
1
0 3
0
2
1 0
0
3
2 0
0
4
2 0
0
<NA> 2 00>> table(d1$x2, d1$s2, useNA="always")
0 0.5 1 <NA>
1
0
0 2
0
2
0
2 0
0
3
3
0 0
0
4
2
0 0
0
<NA> 10 0
0>85

名古屋 大学> table(d1$x3, d1$s3, useNA="always")
0 1 <NA>
1
0 2
0
2
3 0
0
3
2 0
0
4
0 2
0
<NA> 1 00>> table(d1$x4_5, d1$s4_5, useNA="always")>

0 1 <NA>
14
2 0
0
21
1 0
0
23
1 0
0
32
1 0
0
34
0 2
0
42
1 0
0
43
1 0
0
NANA 1 00<NA> 0 0
086

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

逆転項目のデータ処理
新しい変数を作る場合
新しい変数名 <- カテゴリ最小値 + カテゴリ最大値 － 元の変数名上書きする場合
変数名 <- カテゴリ最小値 + カテゴリ最大値 － 変数名
1～5の5段階評定なら，1+5-変数名 = 6-変数名
0～4の4段階評定なら，0+4-変数名 = 4-変数名など> setwd("d:\\")> d1 <- read.table("逆転項目_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> # 最初の数行を表示する> head(d1)
id x1 x2 x3
1 1 3 3 2
2 2 3 5 3
3 3 5 4 3
4 4 4 1 1
5 5 5 4 1
6 6 3 1 2>
> # 念のためデータフーレムのコピーを作っておく> d0 <- d1>> # 最小カテゴリ値，最大カテゴリ値> minx <- 1
> maxx <- 5>>
> # 項目得点の逆転> # もとの変数を別名で保存しておく> d1$x2moto <- d1$x2>> # x2 の得点を逆転させる> d1$x2 <- minx + maxx - d1$x2>>>>> # 逆転の確認> # 新しい変数と元の変数のカテゴリ対応> table(d1$x2moto, d1$x2, dnn=c("x2moto","x2"))
x2
x2moto 1 2 3 4 5
1 0 0 0 0 5
2 0 0 0 4 0
3 0 0 4 0 0
4 0 3 0 0 0
5 4 0 0 0 0>>> # データフレームの確認> head(d1)
id x1 x2 x3 x2moto
1 1 3 3 23
2 2 3 1 35
3 3 5 2 34
4 4 4 5 11
5 5 5 2 14
6 6 3 5 2
1

> # データフレームの保存> write.table(d1, "逆転済み_データ.csv", sep=",", row.names=FALSE, fileEncoding="shift-jis")87名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

尺度得点の計算
合計得点
変数リスト名 <- c("変数名1", "変数名2", …, "変数名p")
合計得点変数 <- rowSums(データフレーム名[,変数リスト名])
平均得点（合計得点／項目数）
変数リスト名 <- c("変数名1", "変数名2", …, "変数名p")
平均得点変数 <- rowMeans(データフレーム名[,変数リスト名])> setwd("d:\\")> d1 <- read.table("合計得点_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id x1 x2 x3 x4 x5 x6 x7 x8
1 1 3 3 2 3 1 2 3 1
2 2 3 3 2 3 2 3 3 2
3 3 3 3 2 1 1 1 1 1
4 4 3 3 2 2 1 2 3 1
5 5 3 3 3 3 3 3 3 3
6 6 3 3 2 3 2 2 2 2>> #変数リスト名> list.goukei <- c("x1", "x2", "x3", "x4", "x5", "x6", "x7", "x8")>> #合計得点の計算> d1$goukei <- rowSums(d1[,list.goukei])> d1$mean8 <- rowMeans(d1[,list.goukei])>> head(d1)
id x1 x2 x3 x4 x5 x6 x7 x8 goukei mean8
1 1 3 3 2 3 1 2 3 1
18 2.250# 2.25 = 18 / 8
2 2 3 3 2 3 2 3 3 2
21 2.625
3 3 3 3 2 1 1 1 1 1
13 1.625
4 4 3 3 2 2 1 2 3 1
17 2.125
5 5 3 3 3 3 3 3 3 3
24 3.000
6 6 3 3 2 3 2 2 2 2
19 2.375>> #データフレームの保存> write.table(d1, "合計得点_結果.csv", row.names=FALSE, sep=",", fileEncoding="shift-jis")>

読み込んだデータ

合計得点を加えたデータ

88

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

データの標準化・中心化・偏差値化
scale(データフレーム名)
特に指定しなければ，変数ごとに，平均=0，標準偏差=1 に標準化
center=c(値1,値2,…) を指定すると，平均値が(値1,値2,…)だけずれる．
scale=FALSE とすると，標準偏差はもとのままとなる．

> setwd("d:\\")> d1 <- read.table("データ例.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id x1 x2 x3 x4
1 1 23 28 23 17
2 2 18 22 23 14
3 3 15 12 15 13
4 4 12 16 22 25
5 5 5 24 13 28
6 6 14 16 15 16
>
>
>
>
>
> # もとのデータの記述統計量> dtmp <- d1[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cov(dtmp)> cnames <- paste("c", colnames(ctmp), sep="")> rtmp <- cor(dtmp)> rnames <- paste("r", colnames(rtmp), sep="")> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp, rtmp),2)> colnames(ktmp) <- c("N","Mean","SD",cnames, rnames)> ktmpN Mean
SD
cx1
cx2
cx3
cx4
rx1
rx2
rx3
rx4
x1 245 15.22 5.37 28.80 -3.38 11.69 -9.70 1.00 -0.10 0.43 -0.26
x2 245 20.32 6.08 -3.38 37.00 -10.06 23.80 -0.10 1.00 -0.32 0.56
x3 245 18.52 5.12 11.69 -10.06 26.18 -16.35 0.43 -0.32 1.00 -0.46
x4 245 16.61 6.98 -9.70 23.80 -16.35 48.66 -0.26 0.56 -0.46 1.00>>>
> #データの標準化> d2 <- scale(d1[,c(-1)])>> # 標準化したデータの記述統計量> dtmp <- d2> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cov(dtmp)> cnames <- paste("c", colnames(ctmp), sep="")> rtmp <- cor(dtmp)> rnames <- paste("r", colnames(rtmp), sep="")> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp, rtmp),2)> colnames(ktmp) <- c("N","Mean","SD",cnames, rnames)> ktmpN Mean SD
cx1
cx2
cx3
cx4
rx1
rx2
rx3
rx4
x1 2450 1 1.00 -0.10 0.43 -0.26 1.00 -0.10 0.43 -0.26
x2 2450 1 -0.10 1.00 -0.32 0.56 -0.10 1.00 -0.32 0.56
x3 2450 1 0.43 -0.32 1.00 -0.46 0.43 -0.32 1.00 -0.46
x4 2450 1 -0.26 0.56 -0.46 1.00 -0.26 0.56 -0.46 1.00>
89

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>>> #データの中心化> d3 <- scale(d1[,c(-1)], scale=F)>> # 中心化したデータの記述統計量> dtmp <- d3> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cov(dtmp)> cnames <- paste("c", colnames(ctmp), sep="")> rtmp <- cor(dtmp)> rnames <- paste("r", colnames(rtmp), sep="")> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp, rtmp),2)> colnames(ktmp) <- c("N","Mean","SD",cnames, rnames)> ktmpN Mean
SD
cx1
cx2
cx3
cx4
rx1
rx2
rx3
rx4
x1 2450 5.37 28.80 -3.38 11.69 -9.70 1.00 -0.10 0.43 -0.26
x2 2450 6.08 -3.38 37.00 -10.06 23.80 -0.10 1.00 -0.32 0.56
x3 2450 5.12 11.69 -10.06 26.18 -16.35 0.43 -0.32 1.00 -0.46
x4 2450 6.98 -9.70 23.80 -16.35 48.66 -0.26 0.56 -0.46 1.00>>
> #データの偏差値化> d4 <- scale(d1[,c(-1)])*10 + 50>
> # 偏差値化したデータの記述統計量> dtmp <- d4> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cov(dtmp)> cnames <- paste("c", colnames(ctmp), sep="")> rtmp <- cor(dtmp)> rnames <- paste("r", colnames(rtmp), sep="")> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp, rtmp),2)> colnames(ktmp) <- c("N","Mean","SD",cnames, rnames)> ktmpN Mean SD
cx1
cx2
cx3
cx4
rx1
rx2
rx3
rx4
x1 24550 10 100.00 -10.34 42.55 -25.92 1.00 -0.10 0.43 -0.26
x2 24550 10 -10.34 100.00 -32.32 56.08 -0.10 1.00 -0.32 0.56
x3 24550 10 42.55 -32.32 100.00 -45.80 0.43 -0.32 1.00 -0.46
x4 24550 10 -25.92 56.08 -45.80 100.00 -0.26 0.56 -0.46 1.00
>
>
>

90

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

行名・列名（変数名）・要素名の指定
行名を指定
rownames(データフレーム名) <- c(変数名の並び)
列名（変数名）を指定
colnames(データフレーム名) <- c(変数名の並び)
特定列の名前を指定
colnames(データフレーム名)[当該変数の番号] <- "新しい変数名"
colnamesは2列以上からなるデータフレームには有効だが，ベクトルには無効である．
ベクトルの場合はベクトル名が変数名である．
要素名の指定names(ベクトル名) <- c(変数名の並び)> setwd("d:\\")> d1 <- read.table("制御_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1
x1 x2 x3
1 NA 3 2
2
3 3 2
3
1 3 2
4
3 3 2
5
3 3 3
6
3 3 2
7
2 3 3
8
2 3 2
9
3 3 2
10 2 3 2
11 1 3 2
12 3 3 2
13 1 3 3
14 2 3 2
15 NA NA 2>
> # d1の行数> (nr <- nrow(d1))[1] 15> (nc <- ncol(d1))
[1] 3
>
>
> # d1の変数名> (cnames1 <- colnames(d1))[1] "x1" "x2" "x3">>> # d1の行名列名を指定> rownames(d1) <- c("a","b","c","d","e","f","g","h","i","j",+"k","l","m","n","o")> colnames(d1) <- c("c1","c2","c3")> d1
c1 c2 c3a NA 3 2
b 3 3 2c 1 3 2d 3 3 2e 3 3 3f 3 3 2g 2 3 3h 2 3 291

名古屋 大学
i 3 3
j 2 3
k 1 3
l 3 3
m 1 3
n 2 3
o NA NA
>
>

2
2
2
2
3
2
2

> # 3番目の変数名をe3に変更> colnames(d1)[3] <- "e3"> head(d1)c1 c2 e3a NA 3 2
b 3 3 2c 1 3 2d 3 3 2e 3 3 3f 3 3 2

> # ベクトルに要素名を指定> (r1 <- c(1,2,3))[1] 1 2 3
> names(r1) <- c("v1","v2","v3")> r1
v1 v2 v3
1 2 3
>

92

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

行や列の抽出・削除
行操作
連続した指定行のみ抽出
データフレーム名[開始行:終了行, ]行番号で指定した行のみ抽出
データフレーム名[c(行番号1, 行番号2…), ]行番号で指定した行のみ削除
データフレーム名[c(-行番号1, -行番号2…), ]数値変数の値が，ある値である行のみ抽出
データフレーム名[データフレーム名$変数名==値,]
数値変数の値が，ある値である行のみ削除
データフレーム名[データフレーム名$変数名!=値,]
文字変数の値が，ある値である行のみ抽出
データフレーム名[grepl("値", データフレーム名$変数名, fixed=FALSE),]
文字変数の値が，ある値である行のみ削除
データフレーム名[grepl("値", データフレーム名$変数名, fixed=FALSE)==FALSE,]
列操作
連続した指定列のみ抽出
データフレーム名[, 開始列:終了列]
列番号で指定した列のみ抽出
データフレーム名[, c(列番号1, 列番号2…)]
列番号で指定した列のみ削除
データフレーム名[, c(-列番号1, -列番号2…)]
変数名で指定した列のみ抽出
データフレーム名[, c("変数名1","変数名2"…)]
変数名で指定した列のみ削除
データフレーム名[, (colnames(データフレーム名) %in% c("変数名1","変数名2"…))==FALSE]> setwd("d:\\")> d1 <- read.table("データの抽出_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1
id sex x1 x2 y11
f 1 2 622
f 3 3 43
3
m 5 3 74
4
m 2 1 555
f 2 5 66
6m 3 2 577
f 4 5 98
8m 2 1 6
9
9
1 3 5
10 10
f 4 4 7>93

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 指定行のみ抽出> (d2 <- d1[1:2,])
id sex x1 x2 y
1 1
f 1 2 62 2
f 3 3 4> (d2 <- d1[c(1,3,5),])id sex x1 x2 y
1 1
f 1 2 63 3
m 5 3 75 5
f 2 5 6>
> # 指定行のみ削除> (d2 <- d1[c(-1,-3,-5),])id sex x1 x2 y22
f 3 3 44
4m 2 1 56
6
m 3 2 577
f 4 5 98
8m 2 1 6
9
9
1 3 5
10 10
f 4 4 7>
> # 変数の値が，ある値である行のみを抽出> (d2 <- d1[d1$x1==1,])
id sex x1 x2 y
1 1
f 1 2 69 9
1 3 5

# d1 の x1 の値が 1 のとき TRUE，それ以外のとき FALSE で，# TRUE の行だけが残る> (d2 <- d1[grepl("f", d1$sex, fixed=FALSE),])
id sex x1 x2 y11
f 1 2 6
# d1 の sex に f が含まれるとき TRUE，それ以外のとき FALSE で，
22
f 3 3 4
# TRUE の行だけが残る
55
f 2 5 677
f 4 5 910 10
f 4 4 7>
> # 変数の値が，ある値である行のみを削除> (d2 <- d1[d1$x1!=1,])
id sex x1 x2 y22
f 3 3 43
3
m 5 3 74
4
m 2 1 555
f 2 5 66
6m 3 2 577
f 4 5 98
8m 2 1 610 10
f 4 4 7> (d2 <- d1[grepl("f", d1$sex, fixed=FALSE)==FALSE,])id sex x1 x2 y
3 3
m 5 3 74 4
m 2 1 56 6
m 3 2 58 8
m 2 1 6
9 9
1 3 5
>
>

94

名古屋 大学> # 指定列のみ抽出> (d2 <- d1[,c(3,5)])
x1 y
1
1 6
2
3 4
3
5 7
4
2 5
5
2 6
6
3 5
7
4 9
8
2 6
9
1 5
10 4 7> (d2 <- d1[,c("x1","y")])
x1 y
1
1 6
2
3 4
3
5 7
4
2 5
5
2 6
6
3 5
7
4 9
8
2 6
9
1 5
10 4 7>> # 指定列のみ削除> (d2 <- d1[,c(-3,-5)])
id sex x2
1
1
f 2
2
2
f 3
3
3
m 3
4
4
m 1
5
5
f 5
6
6
m 2
7
7
f 5
8
8
m 1
9
9
3
10 10
f 4
> (d2 <- d1[,(colnames(d1) %in% c("x1","y"))==FALSE])
id sex x2
1
1
f 2
2
2
f 3
3
3
m 3
4
4
m 1
5
5
f 5
6
6
m 2
7
7
f 5
8
8
m 1
9
9
3
10 10
f 4
>

95

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

データの並べ替え
データフレーム名[order(データフレーム名$並べ替え変数名1，データフレーム名$並べ替え変数名2，…),]decreasing=TRUE とすると降順に並べ替える
変数名の前に「-（マイナス）」を付けても，降順にできる．１つの変数で降順，別の変数で昇順にしたい
場合などに便利．
na.last = TRUE とするとNAは最後尾．= FALSE とするとNAは先頭．= NA とするとNAは削除> setwd("d:\\")> d1 <- read.table("採点データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1
id class sex x1 x2 x3 x4 x51
1
af 4 1 1 3 2
22bm 1 1 2 3 433am 2 3 4 3 444am 4 2 3 2 1
55bf 3 3 2 4 366bf 1 4 2 4 277bf NA 3 1 1 4
88am 1 2 4 2 3
99af NA NA NA NA NA
10 10bm 3 4 3 1 4>> # class で並べ替え> (d2 <- d1[order(d1$class),])id class sex x1 x2 x3 x4 x51
1
af 4 1 1 3 233am 2 3 4 3 444am 4 2 3 2 1
88am 1 2 4 2 3
99af NA NA NA NA NA22bm 1 1 2 3 455bf 3 3 2 4 366bf 1 4 2 4 277bf NA 3 1 1 4
10 10bm 3 4 3 1 4>>> # class で降順に並べ替え> (d2 <- d1[order(d1$class, decreasing=TRUE),])
id class sex x1 x2 x3 x4 x52
2bm 1 1 2 3 455bf 3 3 2 4 366bf 1 4 2 4 277bf NA 3 1 1 4
10 10bm 3 4 3 1 41
1af 4 1 1 3 233am 2 3 4 3 444am 4 2 3 2 1
88am 1 2 4 2 3
99af NA NA NA NA NA>>> # class で昇順 , sex 降順 で並べ替え> (d2 <- d1[order(d1$class, -as.numeric(as.factor(d1$sex))),])
id class sex x1 x2 x3 x4 x53
3am 2 3 4 3 444am 4 2 3 2 1# 文字変数に「-」は効かないので，
88am 1 2 4 2 3# factor化したうえで，
1
1
af 4 1 1 3 2# 数値に換えて評価している．
99af NA NA NA NA NA# fが1，mが2になっている．
22bm 1 1 2 3 4
10 10bm 3 4 3 1 455bf 3 3 2 4 366bf 1 4 2 4 277bf NA 3 1 1 496

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

データの結合データを縦に繋げる
rbind(データ名1, データ名2)
データ名1とデータ名2の列変数が対応していなければならない．
データを横に繋げる
各行に同じオブザベーションのデータがある場合
data.frame(データ名1, データ名2)
cbind(データ名1, データ名2)
data.frame を使うと同じ変数名には添え字が付け加えられる．データフレームが作られる．
cbind を使うと同じ変数名はそのままにされる．データフレーム or 行列 が作られる．
各行に同じオブザベーションのデータがない場合
merge(データ名1, データ名2, by="変数名", all=FALSE/TRUE)
all=TRUE とすると，byで指定された変数が非対応のデータも結合する．all= を指定しないか all=FALSEとすると，byで指定された変数が対応するデータのみを結合する．
データ1とデータ2で，対応させる変数の名前が異なるときは，by.x="データ1での変数名", by.y="データ2での変数名" と指定する．

> setwd("d:\\")>> d.a1 <- read.table("データ結合A1.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d.a2 <- read.table("データ結合A2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d.a1
id sex age x1 x2
1 1
M 28 A 17
2 2
F 22 B 14
3 3
M 24 B 13
4 4
M 25 A 25
5 5
M 24 A 28

データ結合A1.csv> d.a2
id sex age x1 x2
1 6
F 18 A 16
2 7
F 29 A 22
3 8
M 25 C 6
4 9
M 23 D 8
5 10
F 19 A 10>

データ結合A2.csv> #データフレームを縦に繋げる> da <- rbind(d.a1,d.a2)> da
id sex age x1 x2
1
1
M 28 A 17
2
2
F 22 B 14
3
3
M 24 B 13
44
M 25 A 25
55
M 24 A 28
66
F 18 A 16
7
7
F 29 A 2288
M 25 C 699
M 23 D 8
10 10
F 19 A 10>>

97

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> d.b1 <- read.table("データ結合B1.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d.b2 <- read.table("データ結合B2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d.b3 <- read.table("データ結合B3.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d.b1
id sex age
1
1
M 28
2
2
F 22
3
3
M 24
4
4
M 25
5
5
M 24
6
6
F 18
7
7
F 29
8
8
M 25
9
9
M 23
10 10
F 19

データ結合B1.csv> d.b2
id x1 x2
1
1 A 172
2 B 143
3 B 13
4
4 A 255
5 A 286
6 A 167
7 A 22
8
8 C 6
9
9 D 8
10 10 A 10

データ結合B2.csv> d.b3
id x1 x2
1 1 A 17
2 3 B 13
3 4 A 25
4 7 A 225 10 A 10>
データ結合B3.csv> #データフレームを横に繋げる> #横に繋げた結果がデータフレーム> d.bd <- data.frame(d.b1, d.b2)> d.bdid sex age id.1 x1 x2
1
1
M 28
1 A 172
2F 22
2 B 143
3M 24
3 B 134
4M 25
4 A 2555M 24
5 A 2866F 18
6 A 1677F 29
7 A 22
8
8
M 25
8 C 6
9
9
M 23
9 D 8
10 10
F 19
10 A 10>> #横に繋げた結果がデータフレームまたは行列> d.bc2 <- cbind(d.b1, d.b2)> d.bc2
id sex age id x1 x2
1
1
M 28 1 A 17
2
2
F 22 2 B 14
3
3
M 24 3 B 13
44
M 25 4 A 25
55
M 24 5 A 28
66
F 18 6 A 16
7
7
F 29 7 A 2288
M 25 8 C 699
M 23 9 D 8
10 10
F 19 10 A 10>98

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #byで指定された変数が対応するデータのみを結合> d.bm <- merge(d.b1, d.b3, by="id")> d.bmid sex age x1 x2
1 1
M 28 A 17
2 3
M 24 B 13# 非対応行は削除される
3 4
M 25 A 25
4 7
F 29 A 22
5 10
F 19 A 10>> #byで指定された変数が非対応のデータも結合> d.bmc <- merge(d.b1, d.b3, by="id", all=TRUE)> d.bmc
id sex age
x1 x2
1
1
M 28
A 17
2
2
F 22 <NA> NA# 非対応行のデータはNA（Not Available，欠測値）となる
3
3
M 24
B 13
4
4
M 25
A 25
5
5
M 24 <NA> NA
6
6
F 18 <NA> NA
7
7
F 29
A 22
8
8
M 25 <NA> NA
9
9
M 23 <NA> NA
10 10
F 19
A 10
>

99

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のあるデータ（縦断的データ）のフォーマット変換 － Long Format and Wide Format
Ｒで対応のあるデータを扱う際，・対応のあるデータをすべて縦に並べた1つの従属変数
・どの研究参加者のデータかを表す変数
・どの条件の下のデータかを表す変数からなるデータに，フォーマットを変換する必要が生じることがある。
多くの場合，対応のあるデータはWideフォーマットという形式で入力されている。
これをＲ上で，Longフォーマットといわれる形式に変換する。
stack，unstack関数を使う方法
Long format
データフレーム名 <- stack(Wideフォーマットデータ名))
Wide format
データフレーム名 <- unstack(Longフォーマットデータ名))
reshape関数を使う方法
Long format
データフレーム名 <- reshape(data=データ名, idvar="id変数名", v.names="従属変数につける名前",
varying=c("対応のある変数名1","対応のある変数名2",…),
timevar="時点（条件）を表す変数名", times=c("時点1","時点2",…),
direction="フォーマット形式")
Wide format
データフレーム名 <- reshape(Longフォーマットデータ名)> setwd("d:\\")> d1 <- read.table("unstack_データ.csv", header=TRUE, sep=",")> d1
id gender t1 t2 t3
1 1
F 2 1 12 2
F 4 3 23 3
M 6 5 84 4
M 8 7 105 5F 10 9 16>> # stack-unstack 関数を使う方法>> # long format> d2 <- d1[,c("t1","t2","t3")]> (d3 <- stack(d2))
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
>
>

values ind
2 t1
4 t1
6 t1
8 t1
10 t1
1 t2
3 t2
5 t2
7 t2
9 t2
1 t3
2 t3
8 t3
10 t3
16 t3

100

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # wide format> (d3w <- unstack(d3))
t1 t2 t31 2 1 12 4 3 23 6 5 84 8 7 10
5 10 9 16>> # long format data への属性変数の追加> d4 <- data.frame(d1$id, d1$gender, d3)> colnames(d4) <- c("id", "gender", "y", "x")> d4$id <- as.factor(d4$id)> d4$x <- as.factor(d4$x)
> d4
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
>
>

id gender y x
1
F 2 t1
2
F 4 t1
3
M 6 t14
M 8 t1
5
F 10 t1
1
F 1 t22
F 3 t2
3
M 5 t24
M 7 t25
F 9 t2
1
F 1 t32
F 2 t3
3
M 8 t3
4
M 10 t3
5
F 16 t3> #行番号，列変数名を使って long format データを作る方法> d2 <- as.matrix(d1[, c(-1,-2)])> cname.d2 <- colnames(d2)> x <- as.factor(col(d2))> x <- factor(x, levels=seq(1:length(cname.d2)), labels=cname.d2)> id <- as.factor(row(d2))> gender <- as.factor(d1$gender)> (d4 <- data.frame(id, gender, x, y=as.vector(d2)))
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
>
>

id gender x y1
F t1 2
2
F t1 4
3
M t1 6
4
M t1 85
F t1 101
F t2 1
2
F t2 33
M t2 54
M t2 75
F t2 91
F t3 1
2
F t3 23
M t3 84
M t3 105
F t3 16101

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # reshape 関数を使う方法> # long format> (d4 <- reshape(data=d1, idvar="id", varying=c("t1","t2","t3"), v.names="y",+timevar="x", times=c("t1","t2","t3"), direction="long"))
1.t1
2.t1
3.t1
4.t1
5.t1
1.t2
2.t2
3.t2
4.t2
5.t2
1.t3
2.t3
3.t3
4.t3
5.t3
>

id gender x y1
F t1 2
2
F t1 4
3
M t1 6
4
M t1 85
F t1 101
F t2 1
2
F t2 33
M t2 54
M t2 75
F t2 91
F t3 1
2
F t3 23
M t3 84
M t3 105
F t3 16> # wide format> (d4w <- reshape(d4))
1.t1
2.t1
3.t1
4.t1
5.t1
>

id gender t1 t2 t31
F 2 1 12
F 4 3 23
M 6 5 84M 8 7 105F 10 9 16> #手作業で stack データを作成>> #標本の大きさ> nrow.d1 <- nrow(d1)>> x <- rep("t1", nrow.d1)> d2.1 <- data.frame(id = d1$id, gender=d1$gender, x , y=d1$t1)> d2.1
id gender x y
1 1
F t1 2
2 2
F t1 4
3 3
M t1 6
4 4
M t1 85 5
F t1 10>> x <- rep("t2", nrow.d1)> d2.2 <- data.frame(id = d1$id, gender=d1$gender, x , y=d1$t2)> d2.2
id gender x y
1 1
F t2 1
2 2
F t2 33 3
M t2 5
4 4
M t2 75 5
F t2 9>> x <- rep("t3", nrow.d1)> d2.3 <- data.frame(id = d1$id, gender=d1$gender, x , y=d1$t3)> d2.3id gender x y
1 1
F t3 1
2 2
F t3 2
3 3
M t3 84 4
M t3 105 5
F t3 16102

名古屋 大学>> #データの結合> d2 <- rbind(d2.1, d2.2, d2.3)> d2
id gender x y
1
1
F t1 2
2
2
F t1 43
3
M t1 64
4
M t1 85
5
F t1 10
61
F t2 1
7
2
F t2 38
3
M t2 59
4
M t2 7
10 5
F t2 911 1
F t3 1
12 2
F t3 2
13 3
M t3 814 4
M t3 1015 5
F t3 16>>>103

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学
データ型の確認・変換
データ値が，数値か文字かなどの類型
数値型
複素数型
文字型
論理型

> x <- 0> y <- 5+0i
> z <- "4"> w <- TRUE>>
> # データ型の確認> mode(x)[1] "numeric"> is.numeric(x)[1] TRUE> is.complex(y)[1] TRUE> is.character(z)[1] TRUE> is.logical(w)[1] TRUE> # データ型の変換>> # as.～ をつかうと，その時だけ型が変わる> as.numeric(z)
[1] 4
> z
[1] "4">> as.complex(z)[1] 4+0i> z# z は文字のままなので，虚数表示にならない[1] "4">> # mode関数をつかうと変数の型そのものが変わる> mode(z) <- "numeric"
> z
[1] 4
>
> as.complex(z)[1] 4+0i> z# z は数値になっているので，虚数表示になる
[1] 4
>

104

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

データ構造の確認・変換
データの並びがどのような構造になっているかの類型
ベクトル： 要素の型が同一な，データの1次元のならび行列： 要素の型が同一な，データの2次元のならびで，行及び列の要素数がそれぞれ等しい
配列： 要素の型が同一な，データの3次元以上の行列
リスト： 異なる構造のデータをひとまとまりにしたもの
データフレーム ： 2次元の行列状だが各列のデータ構造は異なっても良い．各行，各列はラベルを持つ
順序なし因子： 異なる要素の値をカテゴリとするカテゴリカル変数
順序付き因子： 異なる要素の値をカテゴリとし，カテゴリ間に順序関係のあるカテゴリカル変数> x <- c(1,2)>> # データ構造の確認> is.vector(x)[1] TRUE> is.matrix(x)[1] FALSE> is.array(x)[1] FALSE> is.list(x)[1] FALSE> is.data.frame(x)[1] FALSE> is.factor(x)[1] FALSE> is.ordered(x)[1] FALSE> # データ構造の変換> as.vector(x)[1] 1 2> as.matrix(x)
[,1]
[1,]
1
[2,]
2
> as.array(x)[1] 1 2> as.list(x)
[[1]]
[1] 1
[[2]]
[1] 2
> as.data.frame(x)
x
1 1
2 2
> as.factor(x)[1] 1 2
Levels: 1 2> as.ordered(x)[1] 1 2
Levels: 1 < 2105名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

文字型の数字を数値型の数値に変換
行列名 <- as.matrix(データフレーム名)
storage.mode(行列名) <-"データ型名"
データフレーム名 <- as.data.frame(行列名)
データ型名
numeric：数値型, complex：複素数型, character：文字型, logical： 論理型
型変換したいデータを行列構造にして，すべての変数，データの型を同一にしておき．データ型の変換を行う．最後にデータフレーム構造に戻しておいたほうがよい．
文字型データを数値型にすると，数字は数値に変換されるが，文字は欠測値になる．

> setwd("d:\\")> d1 <- read.table("型変換_データ1.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1
id sex x1 x2 x3
1 1
F 1 2 42 2
F 2 4 33 3
M 4 2 54 4
M 1 5 25 5
F 3 2 26 6
F 4 2 37 7
M 5 3 6>
> d2 <- read.table("型変換_データ2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d2
id sex x1 x2 x3
1 1
F 1
2 5
2 2
F 2
4 3
3 3
M 4
2 5
4 4
M 1
5 2
5 5
F 3
2 2
6 6
F 4
2 a
7 7
M 5 3,6 6>>> # d1は全てのデータが数値型なので，そのまま計算できる> d1$xt <- rowSums(d1[,c("x1","x2","x3")])> d1
id sex x1 x2 x3 xt
1 1
F 1 2 4 7
2 2
F 2 4 3 9
3 3
M 4 2 5 11
4 4
M 1 5 2 85 5
F 3 2 2 7
6 6
F 4 2 3 9
7 7
M 5 3 6 14>
> # d2は，数値と文字が混在しているので，そのままでは計算できない> d2$xt <- rowSums(d2[,c("x1","x2","x3")])
以下にエラー rowSums(d2[,c("x1", "x2", "x3")]) :'x' は数値でなければなりません>>> # データ型の変換> # 行列構造にしてデータ型をそろえる> d3 <- d2[,c("x1","x2","x3")]> d3 <- as.matrix(d3)> mode(d3)[1] "character"106名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

> d3
x1 x2
x3
[1,] "1" "2""5"[2,] "2" "4""3"[3,] "4" "2""5"[4,] "1" "5""2"[5,] "3" "2""2"[6,] "4" "2""a"[7,] "5" "3,6" "6"># すべて文字型のデータになっている> # データ型を数値型にする．文字はNAに変換される> storage.mode(d3) <-"numeric"
警告メッセージ：
In storage.mode(d3) <- "numeric" : 強制変換により NA が生成されました
> d3
[1,]
[2,]
[3,]
[4,]
[5,]
[6,]
[7,]

x1 x2 x3
1 2 5
2 4 3
4 2 5
1 5 2
3 2 2
4 2 NA
5 NA 6> mode(d3)[1] "numeric">> # データフレーム構造に戻しておく> d3 <- as.data.frame(d3)> d3
x1 x2 x3
1 1 2 5
2 2 4 33 4 2 54 1 5 25 3 2 26 4 2 NA7 5 NA 6>> # もとのd2のかたちに戻す> d2 <- data.frame(d2[,c("id","sex")], d3)>> # 数値型になったデータで計算をする> d2$xt <- rowSums(d2[,c("x1","x2","x3")])> d2
id sex x1 x2 x3 xt
1 1
F 1 2 5 8
2 2
F 2 4 3 9
3 3
M 4 2 5 11
4 4
M 1 5 2 85 5
F 3 2 2 7
6 6
F 4 2 NA NA
7 7
M 5 NA 6 NA
>
>

107

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

factor型のデータ値の扱い
ifelse文などにおいて，factor型変数のデータ値を参照しようとすると，データ値ではなく水準番号に値が置き換わってしまうことがある．このような場合は，factor型のデータを，character型に変えて参照する．
オブジェクト名<- as.character(factor型データ)> setwd("d:\\")> d1 <- read.table("データの抽出_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1
id sex x1 x2 y11
f 1 2 622
f 3 3 43
3
m 5 3 74
4
m 2 1 555
f 2 5 66
6m 3 2 577
f 4 5 98
8m 2 1 6
9
9
1 3 5
10 10
f 4 4 7>
> # データ型の確認> is.factor(d1$sex)[1] TRUE>> # カテゴリ値の確認># 空白=1，m=2，f=3という，水準番号とカテゴリ値の対応になっている> d1$sex[1] f f m m f m f mfLevels: f m>> # 空白＝Unknown，その他はもとのままにしたい># factor型変数をそのまま参照># 要素番号がデータになってしまう> d1$sex1 <- ifelse(d1$sex=="", "Unkown", d1$sex)> d1
id sex x1 x2 y
sex1
11
f 1 2 6222
f 3 3 42
3
3
m 5 3 73
4
4m 2 1 5355
f 2 5 62
6
6m 3 2 5377
f 4 5 92
88m 2 1 6399
1 3 5 Unkown
10 10
f 4 4 72>>
# factor型をcharacter型に変換して参照>#> d1$sex1 <- ifelse(d1$sex=="", "Unkown", as.character(d1$sex))> d1
id sex x1 x2 y
sex1
11
f 1 2 6f22
f 3 3 4f3
3
m 5 3 7m
4
4
m 2 1 5m
5
5
f 2 5 6f
6
6m 3 2 5m
7
7
f 4 5 9f
8
8m 2 1 6m
9
9
1 3 5 Unkown
10 10
f 4 4 7f108

名古屋 大学>>>>> # b は character型> (b <- "B")[1] "B">> # fb は factor型> (fb <- as.factor(b))[1] B
Levels: B>> # abc は 要素を10,20,30とするベクトル> abc <- c(10,20,30)>> # abc の要素の名前はA,B,C> names(abc) <- c("A","B","C")
> abc
A B C
10 20 30>
> # abcの中で，名前がbに対応する要素> abc[b]B20>> # abcの中で，名前がfbの値の水準番号に対応する要素> abc[fb]A
10>> # abcの中で，名前ばfbの値に対応する要素> abc[as.character(fb)]
B
20
>

109

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

度数分布表
質的変数
table(変数名)
prop.table(テーブル名)
table：度数．
prop.table：割合．
量的変数
library(fdth)
オブジェクト名 <- fdt(変数名, start=始まりの値, end=終わりの値, h=階級幅)
あらかじめ fdth パッケージをインストールしておく必要がある．

> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")>> # 質的変数の度数分布表> t1 <- table(d1$学科)> p1 <- prop.table(t1)*100> rbind(t1,p1)
医学
看護学
心理学
t1 76.00000 100.00000 94.00000
p1 28.14815 37.03704 34.81481>> # 量的変数の度数分布表> library(fdth)> (t1 <- fdt(d1$自己効力感, start=25, end=80, h=5))Class limits f
rf rf(%) cf cf(%)[25,30) 4 0.01 1.48
4
1.48
[30,35) 8 0.03 2.96 12
4.44[35,40) 29 0.11 10.74 41 15.19[40,45) 42 0.16 15.56 83 30.74[45,50) 54 0.20 20.00 137 50.74[50,55) 50 0.19 18.52 187 69.26[55,60) 40 0.15 14.81 227 84.07[60,65) 28 0.10 10.37 255 94.44[65,70) 9 0.03 3.33 264 97.78[70,75) 5 0.02 1.85 269 99.63[75,80) 1 0.00 0.37 270 100.00

110名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

クロス集計表
度数だけのクロス表
table(変数名1, 変数名2)
行周辺度数（行和）margin.table(テーブル名, 1)
行和に対する割合
prop.table(テーブル名, 1)
列周辺度数（列和）margin.table(テーブル名, 2)
列和に対する割合
prop.table(テーブル名, 2)
総周辺度数（総和）margin.table(テーブル名)
総和に対する割合
prop.table(テーブル名)
次元名（変数名）の指定
table 関数でdnnオプションを使う
dnn=list("行名","列名")作成した表にあとから次元名を付ける
names(dimnames(テーブル名)) <- c("変数名1","変数名2",…)次元名を指定すると，行名，列名を表示することができる（指定しないと表示されない）．

> setwd("d:\\")> d1 <- read.table("度数分布_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)idsex score
grade
1 1 f
85 A
2 2 f
100 A
3 3 m
80 A
4 4 f
80 A
5 5 f
65 C
6 6 m
80 A
>
> # 度数だけのクロス表> t1 <- table(d1$sex, d1$grade, dnn=list("sex", "grade"))
> t1
grade
sex
A
B
C
D
f
25
18
7
1
m
15
12
8
4
>
>
> # 行周辺度数（行和）> margin.table(t1, 1)
sex
f
m
51
39
>
> # 行和に対する割合> prop.table(t1,1)
grade
sex
A
B
C
D
f
0.49019608 0.35294118 0.13725490 0.01960784
m
0.38461538 0.30769231 0.20512821 0.10256410
111

名古屋 大学>> # 列周辺度数(列和)> margin.table(t1, 2)
grade
A
B
C
40
30
>

15

D

5

> # 列和に対する割合> prop.table(t1,2)
grade
sex
A
B
C
D
f
0.6250000 0.6000000 0.4666667 0.2000000
m
0.3750000 0.4000000 0.5333333 0.8000000>> # 総周辺度数(総和）> margin.table(t1)[1] 90>> # 総和に対する割合> prop.table(t1)
grade
sex
A
B
C
D
f
0.27777778 0.20000000 0.07777778 0.01111111m
0.16666667 0.13333333 0.08888889 0.04444444
>
>
>

112

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

割合なども入ったクロス集計表
gmodels パッケージの CrossTable 関数を使う方法
library(gmodels)
CrossTable(変数1, 変数2)
あらかじめ gmodels パッケージをインストールしておく必要がある．
expected=TRUIE とすると，期待度数と，カイ２乗値検定の結果を表示する．
fisher=TRUE や mcnemar=TURE とすると，フィッシャーの直接検定やマクネマーの検定をしてくれる．
descr パッケージの CrossTable 関数を使う方法
library(descr)
CrossTable(変数1, 変数2)
あらかじめ descr パッケージをインストールしておく必要がある．
デフォルトで期待値の表示と，カイ２乗検定をしてくれる．
fisher=TRUE や mcnemar=TURE とすると，フィッシャーの直接検定やマクネマーの検定をしてくれる．
オリジナル関数を使う方法
cross.table(変数名1, 変数名2)
Ｒ起動後に，一度関数部分を実行しておく必要がある．
digit=桁数で，セルパーセントの有効桁数を指定できる．

クロス集計表の警告メッセージについて
クロス集計表を作成したとき，次のようなメッセージが表示される場合があります。」
警告メッセージ:
chisq.test(tab, correct = FALSE, ...) で:
Chi-squared approximation may be incorrect
これは，データ数が少ないために表示される警告で，エラーではありません。クロス表の検定を行うとき使う「カイ2乗統計量」のカイ2乗分布へのあてはまりが良くないという警告です。
警告が出る原因はデータ数が少ないことによります。大まかな目安ですが，1つ1つのセルに少なくとも5個，できれば10個以上のデータがないと，カイ2乗統計量はあてはまりが悪くなります。

113

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("度数分布_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> table(d1$sex, d1$grade)
A
B
C
D
f
25
18
7
1
m
15
12
8
4
>

> #gmodels パッケージの CrossTable 関数を使う方法> library(gmodels)> CrossTable(d1$sex, d1$grade, expected=TRUE)
Cell Contents|-------------------------||N ||Expected N || Chi-square contribution ||N / Row Total ||N / Col Total ||N / Table Total ||-------------------------|
Total Observations in Table:90| d1$grade
d1$sex | A
| B
| C
| D
| Row Total |-------------|-----------|-----------|-----------|-----------|-----------|
f
|
25 |
18 |
7 |
1 |
51 |
|
22.667 |17.000 |8.500 |
2.833 |||
0.240 |
0.059 |
0.265 |
1.186 |||
0.490 |
0.353 |
0.137 |
0.020 |
0.567 ||
0.625 |
0.600 |
0.467 |
0.200 |||
0.278 |
0.200 |
0.078 |
0.011 ||-------------|-----------|-----------|-----------|-----------|-----------|
m
|
15 |
12 |
8 |
4 |
39 |
|
17.333 |13.000 |6.500 |
2.167 |||
0.314 |
0.077 |
0.346 |
1.551 |||
0.385 |
0.308 |
0.205 |
0.103 |
0.433 ||
0.375 |
0.400 |
0.533 |
0.800 |||
0.167 |
0.133 |
0.089 |
0.044 ||-------------|-----------|-----------|-----------|-----------|-----------|
Column Total |
40 |
30 |
15 |
5 |
90 |
|
0.444 |
0.333 |
0.167 |
0.056 ||-------------|-----------|-----------|-----------|-----------|-----------|
Statistics for All Table Factors
Pearson's Chi-squared test-----------------------------------------------------------Chi^2 = 4.038462
d.f. = 3
p = 0.2573408

警告メッセージ：
In chisq.test(t, correct = FALSE, ...) :Chi-squared approximation may be incorrect> detach("package:gmodels")>

114

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #descr パッケージの CrossTable関数を使う方法> library(descr)> (ctd1 <-CrossTable(d1$sex, d1$grade))
Cell Contents|-------------------------||N ||Expected N || Chi-square contribution ||N / Row Total ||N / Col Total ||N / Table Total ||-------------------------|=============================================================
d1$grade
d1$sex
A
B
C
D
Total
------------------------------------------------------------f
25
18
7
1
51
22.7
17.0
8.5
2.8
0.240
0.059
0.265
1.186
0.490
0.353
0.137
0.020
0.567
0.625
0.600
0.467
0.200
0.278
0.200
0.078
0.011
------------------------------------------------------------m
15
12
8
4
39
17.3
13.0
6.5
2.2
0.314
0.077
0.346
1.551
0.385
0.308
0.205
0.103
0.433
0.375
0.400
0.533
0.800
0.167
0.133
0.089
0.044
------------------------------------------------------------Total
40
30
15
5
90
0.444
0.333
0.167
0.056
=============================================================
Statistics for All Table Factors
Pearson's Chi-squared test-----------------------------------------------------------Chi^2 = 4.038462
d.f. = 3
p = 0.2573408
警告メッセージ：
In chisq.test(t, correct = FALSE, ...) :Chi-squared approximation may be incorrect115

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

群別のクロス集計表
度数だけのクロス表
table(変数名1, 変数名2, 群分け変数名)
周辺度数
新データフレーム名 <- データフレーム名[データフレーム名$群分け変数==値, ]margin.table(新データフレーム名)割合
新データフレーム名 <- データフレーム名[データフレーム名$群分け変数==値, ]prop.table(新データフレーム名)> setwd("d:\\")> d1 <- read.table("連関係数_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> #度数だけのクロス表> (t1 <- table(d1$method, d1$grade, d1$sex)), , = FA B C D1 5 19 5 1
2 12 13 4 5
, ,
1
2

= M
A B
5 10
9 5

C
1
4

D
2
0

>
> d1F <- d1[d1$sex=="F",]> d1M <- d1[d1$sex=="M",]> t1F <- table(d1F$method, d1F$grade)> t1M <- table(d1M$method, d1M$grade)>>> #行周辺度数，行和に対する割合> margin.table(t1F, 1)
1 2
30 34
> prop.table(t1F,1)

>

A
B
C
D
1 0.16666667 0.63333333 0.16666667 0.03333333
2 0.35294118 0.38235294 0.11764706 0.14705882> #列周辺度数，列和に対する割合> margin.table(t1F, 2)
A B C D
17 32 9 6
> prop.table(t1F,2)
A
B
CD
1 0.2941176 0.5937500 0.5555556 0.1666667
2 0.7058824 0.4062500 0.4444444 0.8333333>> #総周辺度数，総和に対する割合> margin.table(t1F)[1] 64> prop.table(t1F)A
B
C
D
1 0.078125 0.296875 0.078125 0.015625
2 0.187500 0.203125 0.062500 0.078125
116

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

フラットなクロス集計表
元データから作成する場合
ftable(データフレーム名[,c("変数名1", "変数名2",…)], row.vars=c("変数名1", "変数名2",…))
row.vars で行にカテゴリを並べる変数を指定する．col.vars というオプションをある．
ftable 関数で作られる表では，カテゴリ名が初回のみ表示され，2回目以降は省略される．
すべての行にカテゴリ名が入ったデータを作成するには，ftable で作成した表をデータフレーム化する．
その際，後ろの変数から順にソートされてしまうので，前の変数からソートし直すと比較しやすい．
既にあるクロス表から作成する場合
ftable(列変数名 ~ 行変数名1 + 行変数名2 + …, data=テーブル名)
ftable(.~ 行変数名1 + 行変数名2 + …, data=テーブル名)
フラット化する変数を行変数，フラット化しない変数を列変数に入れる。
すべての変数についてフラット化したい場合は左辺に「.」（ピリオド）を入れる。

> setwd("d:\\")> d1 <- read.table("連関係数_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id sex method grade
1 1
F
1
B
2 2
M
1
B
3 3
F
2
A
4 4
F
1
A
5 5
M
1
B
6 6
M
2
A

> # データからフラットなクロス表をつくる> (ft1 <- ftable(d1[,c("sex","method","grade")], row.vars=c("sex","method","grade")))sex method grade
F
1
A
B
C
D
2
A
B
C
D
M
1
A
B
C
D
2
A
B
C
D

5
19
5
1
12
13
4
5
5
10
1
2
9
5
4
0

# 表なのでカテゴリの値は最小限しか表示されない

117

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # フラットなクロス表をデータ行列に変換> (fd1 <- as.data.frame(ft1))
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

sex method grade Freq
F
1
A
5
M
1
A
5
F
2
A
12
M
2
A
9
F
1
B
19
M
1
B
10
F
2
B
13
M
2
B
5
F
1
C
5
M
1
C
1
F
2
C
4
M
2
C
4
F
1
D
1
M
1
D
2
F
2
D
5
M
2
D
0

# データなのでカテゴリの値がすべての行に入っている> # ソートし直す> (fd1 <- fd1[order(fd1$sex,fd1$method,fd1$grade),])
1
5
9
13
3
7
11
15
2
6
10
14
4
8
12
16

sex method grade Freq
F
1
A
5
F
1
B
19
F
1
C
5
F
1
D
1
F
2
A
12
F
2
B
13
F
2
C
4
F
2
D
5
M
1
A
5
M
1
B
10
M
1
C
1
M
1
D
2
M
2
A
9
M
2
B
5
M
2
C
4
M
2
D
0

> # 既にあるクロス表からフラットなクロス表を作成> # クロス表> (t1 <- table(d1[,c("method","grade","sex")], dnn=list("method","grade","sex"))), , sex = F
grade
method A B
1 5 192 12 13

C
5
4

D
1
5

C
1
4

D
2
0

, , sex = M
method
1
2

grade
A B
5 10
9 5

118

名古屋 大学> # フラットなクロス表> ftable(grade ~ sex + method, data=t1)
grade A B C D
sex method
F1
5 19 5 12
12 13 4 5M
1
5 10 1 22
9 5 4 0> (ft2 <- ftable(.~ sex + method + grade, data=t1))
sex method grade
F
1
A
B
C
D
2
A
B
C
D
M
1
A
B
C
D
2
A
B
C
D

5
19
5
1
12
13
4
5
5
10
1
2
9
5
4
0

> (fd2<- as.data.frame(ft2))
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
>

sex method grade Freq
F
1
A
5
M
1
A
5
F
2
A
12
M
2
A
9
F
1
B
19
M
1
B
10
F
2
B
13
M
2
B
5
F
1
C
5
M
1
C
1
F
2
C
4
M
2
C
4
F
1
D
1
M
1
D
2
F
2
D
5
M
2
D
0

119

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

フラットなクロス集計表から通常のクロス集計表を作成
xtabls(度数変数名 ~ 変数名1 + 変数名2 + …, data=フラットなクロス表名)
フラットなクロス表は，ftable で作成した表でも，データフレームでもよい．

> setwd("d:\\")> d1 <- read.table("連関係数_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id sex method grade
1 1
F
1
B
2 2
M
1
B
3 3
F
2
A
4 4
F
1
A
5 5
M
1
B
6 6
M
2
A
>
>
>
> # フラットなクロス表> (ft1 <- ftable(d1[,c("sex","method","grade")], row.vars=c("sex","method","grade")))sex method grade
F
1
A
5
B
19
C
5
D
1
2
A
12
B
13
C
4
D
5
M
1
A
5
B
10
C
1
D
2
2
A
9
B
5
C
4
D
0
>
>
> # フラットなクロス表をデータ行列に変換> (fd1 <- as.data.frame(ft1))
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

F
M
F
M
F
M
F
M
F
M
F
M
F
M
F
M

1
1
2
2
1
1
2
2
1
1
2
2
1
1
2
2

A
A
A
A
B
B
B
B
C
C
C
C
D
D
D
D

5
5
12
9
19
10
13
5
5
1
4
4
1
2
5
0

120

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # フラットなクロス表からクロス表を作成> # フラットなクロス表でも，それをデータフレーム化したものでも，クロス表が作成できる> xtabs(Freq~method+grade+sex, data=ft1), , sex = F
grade
method A B
1 5 192 12 13

C
5
4

D
1
5

C
1
4

D
2
0

, , sex = M
method
1
2

grade
A B
5 10
9 5

> xtabs(Freq~method+grade+sex, data=fd1), , sex = F
grade
method A B
1 5 192 12 13

C
5
4

D
1
5

C
1
4

D
2
0

, , sex = M
method
1
2

grade
A B
5 10
9 5

>

121

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

円グラフ
円グラフ
pie(テーブル名，clockwise=TRUE, col=色名)> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
> #度数
> (t1 <- table(d1$進路))
就職 進学 不明
219
38
13
>
> # 円グラフ> par(mar=c(1,1,1,1))> pie(t1,clockwise=TRUE, col=gray(c(0.9, 0.7,1.0)), cex=1.4)>> #度数の割合> (p1 <- prop.table(t1))
就職
進学
不明
0.81111111 0.14074074 0.04814815>

122

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

帯グラフ
帯グラフ
barplot(as.matrix(割合テーブル名), horiz=TRUE, beside=FALSE,
ylim=c(0,1), width=0.3, col=色名, legend.text=TRUE)
ylim： 帯グラフ領域全体の高さ
width： 帯の幅
cex： 文字の大きさの調整
beside: 従属変数の水準別に棒を分けるか
horizontal: 横向きグラフ
las: 軸ラベルの向き．1は水平segments： 直線を引く> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
> #度数
> (t1 <- table(d1$進路))
就職 進学 不明
219
38
13
>

> #度数の割合> (p1 <- prop.table(t1))
就職
進学
不明
0.81111111 0.14074074 0.04814815>

123名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 帯グラフ> # 度数の割合ベクトルを行列に変換するのがポイント> par(mar=c(3,4,3,1))> barplot(as.matrix(p1), horiz=TRUE, beside=FALSE, las=1,+
ylim=c(0,1.4), width=0.3, col=gray(c(0.9, 0.7,1.0)),legend.text=T)>> # 年度別の帯グラフ> #列ごとに割合を算出> (t2 <- table(d1$進路, d1$入学年度))
就職
進学
不明

20Y1 20Y2 20Y3
77
80
62
4
11
23
6
7
0

> (p2 <- prop.table(t2, 2)）
20Y1
20Y2
20Y3
就職 0.88505747 0.81632653 0.72941176
進学 0.04597701 0.11224490 0.27058824
不明 0.06896552 0.07142857 0.00000000> par(mar=c(3,4,3,1))> barplot(as.matrix(p2), horiz=TRUE, beside=FALSE, las=1,+
ylim=c(0,1.4), width=0.3, col=gray(c(0.9, 0.7,1.0)),legend.text=T)> segments(0,-1, 0, 2)124

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

segments()について
segments()は，既存の図に直線を書き加えるコマンドです。カッコ内の4つの値のうち，最初の２つが始点の座標，うしろの2つが終点の座標を表します。
segments(0,-1,0,2)の場合，(0,-1)から(0,2)に至る線分を引くということになります。始点と終点のx座標がともに0なので，縦の直線になります。

帯グラフの凡例と帯が重なることについて
画面の大きさによっては，帯グラフの帯と凡例が重なってしまうことがあります。帯グラフの凡例が帯に重ならないようにするには，帯の幅を狭くすることが考えられます。例えば，width=0.3としているところを，
width=0.2 などとすると，帯の幅が狭くなり，帯と凡例が離れるようになります。
> # 帯の幅を狭くする> barplot(as.matrix(p2), horiz=TRUE, beside=FALSE, las=1,+
ylim=c(0,1.4), width=0.2, col=gray(c(0.9, 0.7,1.0)),legend.text=T)> segments(0,-1, 0, 2)

125

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

棒グラフ
barplot(変数（または行列）名, ・・・)
群別（変数別）のグラフの比較
barplot(変数（または行列）名, beside=TRUE, legend=TRUE, space=棒の間の大きさ)
オプション
width ： 棒の幅を設定する（横軸に関する他のオプションと一緒に使って初めて有効となる）
space ： 棒間の間隔を設定する
offset ：縦軸の開始点を設定する．表示するデータからも，当該量を引いておく必要がある．
ほかにも，文字の大きさを変えるオプションなど，いろいろ使える．

> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
> # 度数> (t1 <- table(d1$進路))
就職 進学 不明219
38
13
> # 棒グラフ> par(mar=c(5,5,3,1))> barplot(as.matrix(t1), xlim=c(0,5), ylim=c(0,250), ylab="Frequency",+ las=1, beside=TRUE, space=0.5, col=gray(c(0.9, 0.7,1.0)), legend=TRUE)> segments(-1,0, 5,0)>
> # 学科×進路のクロス表> (t2 <- table(d1$学科,d1$進路))

>

医学
看護学
心理学

就職 進学 不明
64
10
2
80
13
7
75
15
4

> #進路ごとに学科を比較した棒グラフ> par(mar=c(5,5,3,1))> barplot(as.matrix(t2), xlim=c(0,14), ylim=c(0,80), ylab="Frequency",+ las=1, beside=TRUE, col=gray(c(0.9, 0.7,1.0)), legend=TRUE)> segments(-1,0, 14,0)>> # 進路×学科のクロス表> (t3 <- table(d1$進路, d1$学科))
就職
進学
不明

医学 看護学 心理学
64
80
75
10
13
15
2
7
4

>
>
> # 学科ごとに進路を比較した棒グラフ> par(mar=c(5,5,3,1))> barplot(as.matrix(t3), xlim=c(0,14), ylim=c(0,80), ylab="Frequency",+ las=1, beside=TRUE, col=gray(c(0.9, 0.7,1.0)), legend=TRUE)> segments(-1,0, 14,0)126

名古屋 大学127

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 棒の間隔を調整したグラフを描く方法> # space オプションを利用する> # あるテスト得点について，性別，自己効力感別（3段階），および，学校別の平均値が以下だったとする．
>> # 性別> mF <- 63; mM <- 61>> # 自己効力感> m1 <- 60; m2 <- 64; m3 <- 62>> # 学校別> mA <- 61; mB <- 63; mC <- 62; mD <- 62>> # 各要因の平均値の棒グラフを，同時に表示する> mgraph <- c(mF, mM, m1, m2, m3, mA, mB, mC, mD)> names(mgraph) <- c("F","M","1","2","3","A","B","C","D")>> barplot(mgraph, xlim=c(1, 18), ylim=c(0,70), ylab="Mean",+ las=1, col=gray(c(0.4,1.0, 0.4,0.7, 1.0, 0.4,0.6,0.8,1.0)), cex.names=0.8,+ legend=F, width=1.2, space=c(2,0, 2,0,0, 2,0,0,0), main="各群の平均点")> segments(0,0, 20,0)>> # 縦軸の原点をずらした図を描く方法> # offsetオプションを利用する> # テスト得点を間隔尺度と考えると，縦軸を０から始める必要はなく，> # もっと見やすいグラフを書くことも考えられる．
> # 縦軸の範囲を，50 から 70 にすることを考える．
>> voffset <- 50> mgraph <- (c(mF, mM, m1, m2, m3, mA, mB, mC, mD) - voffset)> names(mgraph) <- c("F","M","1","2","3","A","B","C","D")>> barplot(mgraph, xlim=c(1, 18), ylim=c(voffset,70), ylab="Mean", offset=voffset,+ las=1, col=gray(c(0.4,1.0, 0.4,0.7,1.0, 0.4,0.6,0.8,1.0)), cex.names=0.8,+ legend=F, width=1.2, space=c(2,0, 2,0,0, 2,0,0,0), main="各群の平均点")> segments(0,voffset, 20,voffset)>

128

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ヒストグラムhist(変数名, オプション群)
breaks=seq(a, b, by=c)：x軸の値を，aからbまで増分cで区切っていく
ylim=c(a,b)：y軸の範囲をaからbまでとする．
las=1：目盛りの値を水平にする．
xlab="aa "：x軸のラベルをaaとする．

> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
>

> # ヒストグラム> par(mar=c(5,5,3,1))> hist(d1$自己効力感, breaks=seq(20, 85, by=5), ylim=c(0,60), las=1, xlab="自己効力感",129

main="")

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

breaks=seq(20,85, by=5)について
seq(x, y, by=z) は，xからyまで，z点刻みの値を作る関数です。よって，seq(20, 85, by=5)は，(10, 25,
30,…, 85)という数値を算出します。
hist 関数の break オプションは，各階級の下限と上限の値を指定するオプションでう。上の例だと
20 < x <= 25
25 < x <= 30…
80 < x <= 65という階級をつくります。
ヒストグラムの横軸の目盛は，基本的に整数値のところに付けられるので，(20, 30, …, 80)のところに目盛がつけられます。
これに対して，seq(17.5,87.5,by=5) とした場合は，
17.5 < x <= 22.5
22.5 < x <= 27.5…
82.5 < x <= 87.5という階級が作られます。この場合は，棒の中央（20, 30,…, 80）に目盛が来るようになります。R> hist(d1$自己効力感, breaks=seq(17.5, 87.5, by=5), ylim=c(0,60), las=1, xlab="自己効力感",
="")

130

main

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２群の積み上げヒストグラム
hist(変数名, オプション群)
hist(一方の群のみのデータ$変数名, col="色指定", add=TURUE)
全体のヒストグラムを描いた上に，一方の群のヒストグラムを重ね合わせる。
breaks=seq(a, b, by=c)：x軸の値を，aからbまで増分cで区切っていく
ylim=c(a,b)：y軸の範囲をaからbまでとする．
las=1：目盛りの値を水平にする．
xlab="aa "：x軸のラベルをaaとする．

> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
>
> # 男だけのデータ> d1m <- d1[d1$性別=="男",]>>>> # 全体のヒストグラムに，男だけのヒストグラムを重ね合わせ> par(mar=c(5,5,3,1))> hist(d1$自己効力感, breaks=seq(20,85, by=5), ylim=c(0,60), las=1, xlab="自己効力感",> hist(d1m$自己効力感, col="gray", add=TRUE)>

131

main="")

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

箱ひげ図
1変数の箱ひげ図
boxplot(変数名)
群別の箱ひげ図boxplot(変数名~群変数名, data=データフレーム名)
クラスごとの群別箱ひげ図
boxplot(変数名~群変数名, data=データフレーム名, subset=クラス変数名==クラス値)
対応のある変数の箱ひげ図
boxplot(対応のある変数を入れたデータフレーム名)> setwd("d:\\")> d1 <- read.table("箱ひげ図_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> #1変数の箱ひげ図> boxplot(d1$pre)>> #群別の箱ひげ図> boxplot(pre~seibetsu, data=d1)>> #クラスごとの群別箱ひげ図> boxplot(pre~seibetsu, data=d1, subset=class=="A", main="class=A")> boxplot(pre~seibetsu, data=d1, subset=class=="B", main="class=B")>> #対応のある変数の箱ひげ図> d2 <- d1[,c("pre", "post1","post2")]> boxplot(d2)1変数の箱ひげ図

群別の箱ひげ図

クラスごとの群別箱ひげ図

対応のある変数の箱ひげ図132

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

折れ線グラフplot(変数ベクトル名, type="タイプ名", オプション名)
type :
l…折れ線，b…○と線分（分離），o…○と線分（結合）, c…分離した折れ線
lty：線種．1実線．2破線．3点線．
lwd：線の太さ．
xaxt="n"：x軸とラベルを表示しない．
yaxt="n"：y軸とラベルを表示しない．

> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
> # 折れ線グラフ> par(mar=c(5,5,3,3))> t1 <- table(d1$進路, d1$入学年度)> p1 <- prop.table(t1,2)> plot(p1["就職",], type="o", ylim=c(0,1), las=1, xlab="入学年度", ylab="proportion", lty=2, lwd=
2, xaxt="n")> par(new=TRUE)> plot(p1["進学",], type="o", ylim=c(0,1), xlab="", ylab="", lty=1, lwd=2, xaxt="n", yaxt="n")> par(new=TRUE)> plot(p1["不明",], type="o", ylim=c(0,1), xlab="", ylab="", lty=3, lwd=2, xaxt="n", yaxt="n")> axis(1, c(1,2,3), colnames(p1))>> # 凡例> text(3, 1.0, "就職")> text(3, 0.96, "進学")> text(3, 0.92, "不明")> segments(2.8,1.0, 2.9,1.0, lty=2, lwd=2)> segments(2.8,.96, 2.9,.96, lty=1, lwd=2)> segments(2.8,.92, 2.9,.92, lty=3, lwd=2)
>
>

133

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

散布図
2変数の散布図plot(x軸変数名, y軸変数名, pch=マーク番号(または"記号"))
多変量の散布図
pairs(データフレーム（または行列）名, pch=マーク番号(または"記号"))> setwd("d:\\")> d1 <- read.table("グラフ_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)class seibetsu pre post1 post2
1
A
0 29
34
30
2
A
0 28
24
32
3
A
1 30
24
33
4
A
1 30
28
31
5
A
1 33
26
34
6
A
1 29
28
34
>

> #2変数の散布図> plot(d1$pre, d1$post1, pch=20, las=1, xlim=c(10,50), ylim=c(10,50),+
xlab="pre", ylab="post1")>>> #多変量の散布図> d2 <- d1[,c("pre", "post1","post2")]> pairs(d2, pch=3)>2変数の散布図

多変量の散布図15 20 25 30 35 40 45

10 15 20 25 30 35 40

10 15 20 25 30 35 40

pre

36

40

post1

28

32

post2

15 20 25 30 35 40 45

134

28

32

36

40

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ひまわり図
座標の重なりを花弁で表示した散布図
sunflowerplot(x軸変数名, y軸変数名, pch=マーク番号(または"記号"))> setwd("d:\\")> d1 <- read.table("グラフ_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)class seibetsu pre post1 post2
1
A
0 29
34
30
2
A
0 28
24
32
3
A
1 30
24
33
4
A
1 30
28
31
5
A
1 33
26
34
6
A
1 29
28
34
>
> sunflowerplot(d1$pre, d1$post1, pch=20, las=1, xlim=c(10,50),+
ylim=c(10,50), xlab="pre", ylab="post1")

135

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

バブルプロット
座標の重なりを円の大きさで表示した散布図
symbols(x軸変数名, y軸変数名, circles=円の半径, inches=小さな値, bg="塗りつぶす色")> setwd("d:\\")> d1 <- read.table("グラフ_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)class seibetsu pre post1 post2
1
A
0 29
34
30
2
A
0 28
24
32
3
A
1 30
24
33
4
A
1 30
28
31
5
A
1 33
26
34
6
A
1 29
28
34
>

# フラットなテーブル> ft1 <- ftable(d1[,c("pre", "post1")], row.vars=c("pre", "post1"))> dt1 <- as.data.frame(ft1)> dt1 <- dt1[dt1$Freq>0,]# 度数が 0 の座標を削除# バブルプロット> symbols(dt1$pre, dt1$post1, circles=sqrt(dt1$Freq/pi), inches=0.07, bg="black", las=1)

136

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ラベルつき散布図
plot(x軸変数名, y軸変数名, pch="", オプション)
text(x軸変数名, y軸変数名, labels=ラベル変数名)> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
>
>
> # 見やすくするため，番号１～20のデータのみ抽出> d2 <- d1[d1$番号<= 20,]>>
> # 散布図の作成> par(mar=c(4,4,1,1))>> # プロットエリアの作成> plot(d2$自己効力感, d2$学習意欲, las=1, pch="", xlab="自己効力感", ylab="学習意欲")>> # ラベルの座標表示> text(d2$自己効力感, d2$学習意欲, labels=d2$番号, cex=1.25)# cex ラベル文字の大きさ調整>

137

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

グラフオプション
par「ヘルプ」→「Rの関数(テキスト)」で「par」を検索すると，グラフに関するさまざまなオプションが表示される．以下はその中の一部である．
図の配列
余白の行数

par(mfrow=c(行数,列数)) 図を何行何列に配列するかを指定する．
par(mar=c(5,5,3,1))など。

c()の中は，下，左，上，右の行数を指定

マーク
pch=マーク番号 または"記号"番号（０～２５，３３～１２６？）により，○，●，△，▲，□，■，◆，＋ などの記号が選べる．
色col="色名"
colors() とすると色名がたくさん表示される．black, blue, gray, green, pink, red, yellow など．

タイトル

main="タイトル"

軸ラベル

xlab="x軸ラベル", ylab="y軸ラベル"

軸ラベルの向き

las=0,1,2, or 3 (軸に平行，水平，軸に垂直，垂直)軸の表示

axes=TRUE（デフォルト）．FALSEにすると軸を自動的には書かない．

軸の範囲

xlim=c(下限,上限), ylim=c(下限,上限)

軸を書く axis( ) 自動設定しないで手動で書く．
目盛りや目盛りの値を指定できる．side=1:x軸下，2：y軸左，3：x軸上，4：y軸右棒の幅

width=幅の大きさ（xlim，ylimを指定時に有効）

横書き

horiz=TRUE（デフォルトはFALSE）

並列配置

beside=TRUE（FALSEにすると積み上げグラフ）

凡例

legend=TRUE（FALSEにすると凡例非表示）

グラフの重ね合わせまたは

add=TRUE
par(new=TRUE)（グラフオプション）（コマンド）

Macで日本語を表示させる family="HiraKakuProN-W3" （フォントを指定）
par(family="HiraKakuProN-W3")
他にもいろいろなオプションがある．

> setwd("d:\\")> d1 <- read.table("グラフ_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> #データの準備> d1a <- d1[d1$class=="A",]> d1b <- d1[d1$class=="B",]>> m3 <- sapply(d1[,c("pre","post1","post2")], tapply, list(d1$seibetsu,d1$class), mean)> rownames(m3) <-c("A0","A1","B0","B1")> m4 <- t(m3)
> m4
A0
A1
B0
B1
pre
24.56 30.71429 23.20588 31.09756
post1 28.64 27.77143 27.14706 27.46341
post2 32.56 32.94286 32.52941 32.51220
138名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #マーク，色，タイトル，軸ラベル，軸の範囲の設定，線分の挿入> plot(d1$pre, d1$post1, pch=20, col="blue", las=1,+
main="pre-post1 plot", xlab="pre-test", ylab="post-test 1",+
xlim=c(0,50), ylim=c(5,45))> segments(mean(d1$pre), 0, mean(d1$pre), 50)# 始点と終点のx,y座標を指定して線分を描く> segments(-10,mean(d1$post1), 60, mean(d1$post1))> # 散布図に回帰直線を乗せる> plot(d1$pre, d1$post1, pch=20, col="blue", las=1,+
main="pre-post1 plot", xlab="pre-test", ylab="post-test 1",+
xlim=c(0,50), ylim=c(5,45))> abline(lm(post1~pre,data=d1))> # グラフに格子線を引く> plot(d1$pre, d1$post1, pch=20, col="blue", las=1,+
main="pre-post1 plot", xlab="pre-test", ylab="post-test 1",+
xlim=c(0,50), ylim=c(5,45))> x <- seq(0, 50, by=5)> y <- seq(5, 45, by=5)> abline(h=y, v=x, lty=2)# lty で線の種類を指定

139

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #2群の散布図> plot(d1a$pre, d1a$post1, pch="A", xlab="pre", ylab="post1")> par(new=TRUE)> plot(d1b$pre, d1b$post1, pch="B", axes=FALSE, xlab="", ylab="")> #棒の幅，横書き，軸の範囲，並列配置，凡例の設定> barplot(m4,width=0.5, horiz=TRUE, xlim=c(0,40), ylim=c(0,12),+
beside=TRUE, legend=TRUE)
2群の散布図の重ね合わせ

B

15

20

25

A
B
B

A
A

A
A

B
15

20

25

A
A
B
B
A

B1

30

post1

B
B

B

A
A A
B B
B
B
B A
B A B B A ABA A
B
A BB A A
B BBB B A A
BAAA B BAB B
AB B B
B AB
A
B
B
BA
ABA
AB BA A B
A
B
B
A
A A
BA B A
B
A
A A
AB
A
A
B
A BB
A
B B
A
A

B A
B
B B

B

B

post2
post1
pre

B

B

B
A

B

B0

B

B

B

A

A1

35

B

AB
B

A0

40

A

棒の幅，横書き，軸の範囲，並列配置，凡例の設定

A
30

35

40

0

10

pre

> #軸を手動で書く> # グラフの目盛りラベルを明示的に書く> boxplot(d1[,3:5], axes=FALSE, xlab="Time", ylab="Score")>> # side = 1:x軸下．１から３目盛りまでに，c()で指定したラベルを書く> axis(side=1, 0:4, c("","Pre Test","Post Test 1","Post Test 2",""))>> # side = 2: ｙ軸左> axis(side=2)>> # side = 3: x軸上> axis(side=3, 1:3, c("Time 1","Time 2","Time 3"))>> # side = 4: y軸右> axis(side=4, seq(10,45,by=7))
>

140

20

30

40

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ggplotを使った作図
ggplot2というパッケージにあるggplotという関数を使うと，より複雑できれいなグラフを描くことができる。基本的には，ggplot()関数のうしろに，必要な関数を + でつなげて描画する。
ggplot2パッケージをインストールする
library(ggplot2)
パッケージを読み込む
ggplot(data=データ名, aes())
グラフを描くキャンパスの大枠を設定する
aes() 内のオプション
x = x軸変数名y = y軸変数名（指定しなければ，x軸変数の度数がy軸になる）
group = 群分け変数名
color = 色分け変数名（線，ドット）fill = 色分け変数名（領域）shape = 記号分け変数名（ドット）geom_bar()
棒グラフ
stat = "identity"： 値そのもので棒の長さを指定する。他に"summary"（平均）などがある
position = "dodge"： 群別に棒（領域）を分ける
position = "fill"： 帯グラフ化する（x軸の値ごとに，y軸を最大幅まで取る）
geom_errorbar(aes())
エラーバー
aes() 内のオプション
ymax = エラーバーの上限
ymin = エラーバーの下限
width = エラーバーの横棒の幅
position = position_dodge(width = 0.9)： 複数のエラーバー間の間隔を調整
geom_histogram()
ヒストグラムbreaks = seq(上限, 下限, by=階級幅)
bins = 棒の数
geom_boxplot()
箱ひげ図
geom_line()
折れ線グラフlinetype = 値： 線種
linewidth = 値： 線の太さ
geom_point()
散布図
position = position_jitter())： ドットの重なりをずらす
geom_smooth()
近似曲線
method = "lm"： 回帰直線
se=F： 誤差の表示（TRUE or FALSE）
xlab("ラベル名")
x軸のラベルを設定する
ylab("ラベル名")
y軸のラベルを設定する
labs()
ラベルを細かく設定する
title="タイトル"
subtitle="サブタイトル"
x="x軸ラベル"： xlab()と同じ役割
y="y軸ラベル"： ylab()と同じ役割
caption="キャプション"
fill="凡例"： aes において fill で色分けした場合
color="凡例"： aes において color で色分けした場合
141

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

scale_y_continuous()
y軸の範囲を設定する
limits = c(下限値, 上限値)：下限と上限を設定する。データの範囲を超えるとエラーになる場合がある
labels = scales::percent： y軸をパーセント表示にする
theme_bw()，theme_classic()，theme_light，theme_test() など
背景色や目盛の表示などを設定する
カッコ内でオプションを指定することもできる
facet_grid( ~群分け変数名)
群別に図を描くnrow = 値：指定された行数に収まるように配列する
ncol = 値：指定された列数に収まるように配列する
facet_grid()
群別に図を描く
rows=vars(群分け変数名)： 群ごとの図を行を変えて表示する
cols=vars(群分け変数名)： 群ごとの図を列を変えて表示する
行変数名~列変数名： グラフを群別に分けて描いて配列表示する際の群分け変数を指定する
coord_flip()
x軸とy軸の入れ替え＊ スクリプトにおいて，関数を「+」でつなぐことを忘れない（コンソール画面上の「+」とは異なる）。
＊ 関数の間で改行するときは，上の行の末尾に「+」をつけて，スクリプトが続くことを明示する> rm(list=ls())> setwd("d:\\Rdocuments\\scripts\\")> # ggplot2パッケージの呼び出し> library(ggplot2)> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>

142

名古屋 大学
度数を比較する棒グラフ ― ggplot> ggplot(data=d1, aes(x = 学科, fill = 学科)) ++geom_bar(width=0.5) ++xlab("学科") + ylab("度数")>> # 入学年度別に棒を分ける> ggplot(data=d1, aes(x = 学科, fill = 入学年度)) ++geom_bar(position = "dodge", width=0.6) ++xlab("学科") + ylab("度数")+theme_bw()> # 学科別に図を分ける> ggplot(data=d1, aes(x = 入学年度, fill = 入学年度)) ++geom_bar(position = "dodge",width=0.5) ++xlab("学科") + ylab("度数") ++theme_bw() ++facet_wrap( ~ 学科, nrow=2)

143

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

平均値を比較する棒グラフ ― ggplot> ggplot(data=d1, aes(x = 学科, y = 自己効力感, fill = 入学年度)) ++geom_bar(stat = "summary", position = "dodge") ++xlab("学科")> # エラーバー付棒グラフ> library(psych)> (ds1 <- describeBy(d1$自己効力感, group=list(d1$学科, d1$入学年度), mat=T, digits=2))
X11
X12
X13
X14
X15
X16
X17
X18
X19

item group1 group2 vars n mean
sd median trimmed
mad min max range skew kurtosis
se
1
医学
20Y1
1 29 49.76 9.83
50.0
49.32 11.86 35 73
38 0.41-0.83 1.83
2 看護学
20Y1
1 28 45.68 8.67
45.0
44.96 5.93 33 68
35 0.970.51 1.64
3 心理学
20Y1
1 30 46.73 10.91
47.5
46.92 14.08 26 66
40 -0.09-1.22 1.99
4
医学
20Y2
1 27 50.26 10.81
52.0
50.87 8.90 26 73
47 -0.50-0.01 2.08
5 看護学
20Y2
1 33 50.55 10.71
49.0
49.85 11.86 34 77
43 0.55-0.43 1.86
6 心理学
20Y2
1 38 49.71 7.90
48.5
49.41 9.64 38 70
32 0.37-0.69 1.28
7
医学
20Y3
1 20 56.00 7.67
54.5
55.75 8.15 41 72
31 0.20-0.69 1.72
8 看護学
20Y3
1 39 50.38 8.11
52.0
50.48 8.90 35 65
30 -0.14-1.08 1.30
9 心理学
20Y3
1 26 48.81 8.58
49.5
48.95 6.67 29 65
36 -0.28-0.31 1.68

> ggplot(data=ds1, aes(x = group1, y = mean, fill = group2)) ++geom_bar(stat = "identity", position = "dodge") ++geom_errorbar(aes(ymax = mean + se, ymin = mean - se),+width = 0.2, position = position_dodge(width = 0.9))++xlab("学科") ++theme_classic()

144

名古屋 大学
帯グラフ ― ggplot> ggplot(data=d1, aes(x = 入学年度, fill = 学科)) ++geom_bar(position="fill", width=0.5) ++ylab("パーセント") ++scale_y_continuous(labels = scales::percent)# 横向き> ggplot(data=d1, aes(x = 入学年度, fill = 学科)) ++geom_bar(position="fill", width=0.5) ++ylab("パーセント") ++scale_y_continuous(labels = scales::percent) ++coord_flip() ++theme_light()

145

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ヒストグラム ― ggplot> ggplot(data=d1, aes(x=自己効力感)) ++ geom_histogram(breaks=seq(20,85, by=5)) ++ xlab("自己効力感")+ ylab("度数")> # 積み上げヒストグラム> ggplot(data=d1, aes(x=自己効力感, fill=性別)) ++ geom_histogram(breaks=seq(20,85, by=5)) ++ labs(title="積み上げヒストグラム", subtitle="性別", x="自己効力感", y="度数",+caption="背景を白色に変えている", fill="凡例") ++ theme_test()> # 群別ヒストグラム> ggplot(data=d1, aes(x=自己効力感, fill=性別)) ++ geom_histogram(breaks=seq(20,85, by=5)) ++ xlab("自己効力感")+ ylab("度数") ++ facet_grid(rows=vars(性別))146名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

箱ひげ図 ― ggplot> ggplot(data=d1, aes(x = 学科, y = 自己効力感)) ++geom_boxplot() + ylim(20, 80)> # x軸とy軸の入れ替え> ggplot(data=d1, aes(x = 学科, y = 自己効力感)) ++geom_boxplot() + ylim(20, 80)+ coord_flip()> # 群分け
> ggplot(data=d1, aes(x = 学科, y = 自己効力感, color=入学年度)) ++geom_boxplot() + ylim(20, 80)

147名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

折れ線グラフ ― ggplot> # フラットなテーブルを作成してデータフレーム化> (ft1 <- as.data.frame(ftable(d1[,c("進路","入学年度")], row.vars=c("進路","入学年度"))))
進路 入学年度 Freq
1 就職
20Y1
77
2 進学
20Y1
4
3 不明
20Y1
6
4 就職
20Y2
80
5 進学
20Y2
11
6 不明
20Y2
7
7 就職
20Y3
62
8 進学
20Y3
23
9 不明
20Y3
0
> # 折れ線グラフ>> ggplot(data=ft1, aes(x=入学年度, y=Freq,+ geom_line(linewidth=2) ++ xlab("入学年度")+ ylab("度数") ++ scale_y_continuous( limits = c(0, 100))>

group=進路,

color=進路)) +> # 線種を変え，点をつける> ggplot(data=ft1, aes(x=入学年度, y=Freq, group=進路, color=進路)) ++ geom_line(linewidth=2, linetype=3) + geom_point(size=4) ++ xlab("入学年度")+ ylab("度数") ++ scale_y_continuous( limits = c(0, 100))

148

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

散布図 ― ggplot> ggplot(data=d1, aes(x = 自己効力感, y = 学習意欲, color = 性別)) ++geom_point()# ドットの重なりをずらした散布図> ggplot(data=d1, aes(x = 自己効力感, y = 学習意欲, color= 性別)) ++geom_point(position = position_jitter())> # 回帰直線を乗せる> ggplot(data=d1, aes(x = 自己効力感, y = 学習意欲, color= 性別)) ++geom_point() + geom_smooth(method = "lm", se=F)> # 年度別，性別に図を分ける> ggplot(data=d1, aes(x = 自己効力感, y = 学習意欲, color=性別)) ++geom_point() + geom_smooth(method = "lm", se=F) ++facet_grid(入学年度~性別)

149

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

平均，標準偏差，最大値，中央値，最小値，分位数
summary(データフレーム名)
colMeans(データフレーム名)
sapply(データフレーム名, sd)

または
または
または

apply(データフレーム名, 2, summary)
apply(データフレーム名, 2, mean)
apply(データフレーム名, 2, sd)summary： 最小値，四分位数，最大値，平均値
colMeans：各列の平均値
mean :
平均値
sd：
標準偏差
max：
最大値
median： 中央値
min：
最小値
quantile(値)： 値で指定された累積比率のところのデータ
na.rm=TRUE : mean や sd などにおいて，欠測値があるときはそれを除外する指定> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
> #分析に必要な変数だけを取り出す> dtmp <- d1[,c("自己効力感","学習意欲")]>> # 標本サイズ> (ntmp <- nrow(dtmp))[1] 270>> # 各変数の平均> (mtmp <- colMeans(dtmp))
自己効力感
学習意欲
49.60000
25.20741>> # 各変数の標準偏差> (sd.d2 <- apply(dtmp, 2, sd))
自己効力感
学習意欲
9.492866
5.099160>> # 各変数の最小値，四分位数，最大値> (summarytmp <- summary(dtmp))
自己効力感
学習意欲
Min.
:26.0
Min.
: 8.00
1st Qu.:42.0
1st Qu.:22.00
Median :49.0
Median :25.00
Mean
:49.6
Mean
:25.21
3rd Qu.:57.0
3rd Qu.:29.00
Max.
:77.0
Max.
:39.00>150

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

群別の平均，標準偏差，最大値，中央値，最小値，分位数
集計したい変数が１つだけの場合
tapply(集計したい変数名, 群分け変数名, 関数, 関数のオプション群)
集計したい変数は１つしか指定できない．
集計したい変数が１つ以上の場合
byを使う方法
by(データフレーム名, 群分け変数名, 関数, 関数のオプション群)
aggregateを使う方法
aggregate(データフレーム名, list(群分け変数名), 関数, 関数のオプション群)
sapplyとtapplyを組み合わせて使う方法
sapply(データフレーム名, tapply, 群分け変数名, 関数, 関数のオプション群)
データフレームは，集計したい変数だけを入れたものにするか，集計したい変数を指定する．

> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
>

> # 各群の標本サイズ> table(d1$入学年度)
20Y1 20Y2 20Y3
87
98
85
>
> # tapplyを使う方法> tapply(d1$学習意欲, d1$入学年度, summary)$`20Y1`
Min. 1st Qu. Median
Mean 3rd Qu.
Max.
8.00
21.50
23.00
24.08
28.50
37.00
$`20Y2`
Min. 1st Qu.
16.00
22.00

Median25.50

Mean 3rd Qu.
25.48
29.00

Max.
39.00

$`20Y3`Min. 1st Qu.
15.00
23.00

Median26.00

Mean 3rd Qu.
26.05
29.00

Max.
38.00

> tapply(d1$学習意欲, d1$入学年度, sd)
20Y1
20Y2
20Y3
5.528401 5.105545 4.445184
151

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> # byを使う方法> by(d1[,c("学習意欲")], d1$入学年度, summary)
d1$入学年度: 20Y1
Min. 1st Qu. Median
Mean 3rd Qu.
Max.
8.00
21.50
23.00
24.08
28.50
37.00
--------------------------------------------------------d1$入学年度: 20Y2
Min. 1st Qu. Median
Mean 3rd Qu.
Max.
16.00
22.00
25.50
25.48
29.00
39.00
--------------------------------------------------------d1$入学年度: 20Y3
Min. 1st Qu. Median
Mean 3rd Qu.
Max.
15.00
23.00
26.00
26.05
29.00
38.00
> by(d1[,c("学習意欲")], d1$入学年度, sd)
d1$入学年度: 20Y1
[1] 5.528401--------------------------------------------------------d1$入学年度: 20Y2
[1] 5.105545--------------------------------------------------------d1$入学年度: 20Y3
[1] 4.445184>> # aggregateを使う方法> aggregate(d1[,c("学習意欲")], list(d1$入学年度), summary)Group.1 x.Min. x.1st Qu. x.Median x.Mean x.3rd Qu. x.Max.
1
20Y1
8.00
21.50
23.00 24.08
28.50 37.00
2
20Y2 16.00
22.00
25.50 25.48
29.00 39.00
3
20Y3 15.00
23.00
26.00 26.05
29.00 38.00> aggregate(d1[,c("学習意欲")], list(d1$入学年度), sd)Group.1
x1
20Y1 5.528401
2
20Y2 5.105545
3
20Y3 4.445184>> # sappy とtapply を組み合わせて使う方法> sapply(d1[,c("学習意欲","自己効力感")], tapply, d1$入学年度, mean)
学習意欲 自己効力感
20Y1 24.08046
47.40230
20Y2 25.47959
50.14286
20Y3 26.04706
51.22353> sapply(d1[,c("学習意欲","自己効力感")], tapply, d1$入学年度, sd)
学習意欲 自己効力感
20Y1 5.528401
9.908253
20Y2 5.105545
9.649529
20Y3 4.445184
8.516617>>>> # 群別にデータフレームを分割する> d1Y1 <- d1[d1$入学年度=="20Y1", ]> d1Y2 <- d1[d1$入学年度=="20Y2", ]> d1Y3 <- d1[d1$入学年度=="20Y3", ]>> #各群における記述統計量> nrow(d1Y1)[1] 87> summary(d1Y1[,c("学習意欲")])Min. 1st Qu. Median
Mean 3rd Qu.
8.00
21.50
23.00
24.08
28.50

Max.
37.00

> sd(d1Y1[,c("学習意欲")])[1] 5.528401

152

名古屋 大学
要約統計量

大 学院 教育発 達科 学研 究科・ 教育 学部― describe, describeBy

library(psych)
describe(データフレーム名[,c("変数名1","変数名2",...)])
群ごとの表示byを使う方法
library(psych)by(データフレーム名, 群分け変数名, describe)
describeByを使う方法
library(psych)
describeBy(データフレーム名, 群分け変数名)
あらかじめpsychパッケージをインストールしておく必要がある．
mat=TRUEと指定すると行列表記になる。
list(群分け変数1, 群分け変数2)などとして，入れ子状に複数の群分け変数を指定することもできる。
出力内容
item name
変数名
item number
標本の大きさnumber of valid cases 有効数
mean
算術平均
standard deviation 標準偏差（分母=n-1）
trimmed mean (with trim defaulting to .1) 調整平均(指定した割合の両端データを削除したときの平均)
median (standard or interpolated 中央値
mad: median absolute deviation (from the median) 1.4826 ×[中央値からの絶対偏差]の中央値
minimum
最小値
maximum
最大値
skew
歪度
kurtosis
尖度
standard error 標準誤差

> setwd("d:\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
1
2
3
4
5
6
>

番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
20Y1 看護学
女
高
49
23 就職
2
20Y2 心理学
男
低
57
29 就職
3
20Y1
医学
女
高
42
23 進学
4
20Y1 看護学
女
高
41
23 就職
5
20Y2
医学
男
低
41
22 就職
6
20Y1 心理学
女
低
47
24 就職

> #psych パッケージの読み込み> library(psych)>
153名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 記述統計量の一括表示> describe(d1[,c("学習意欲","自己効力感")])
学習意欲
自己効力感

vars
n meansd median trimmed
mad min max range skew kurtosisse1 270 25.21 5.10
25
25.22 4.45
8 39
31 -0.01
0.08 0.31
2 270 49.60 9.49
49
49.51 10.38 26 77
51 0.10-0.31 0.58

> # 群別の記述統計量の一括表示> # byを使う方法> by(d1[,c("学習意欲","自己効力感")], d1$入学年度, describe)
d1$入学年度: 20Y1
vars n mean
sd median trimmed
mad min max range skew kurtosisse
学習意欲
1 87 24.08 5.53
23
24.15 4.45
8 37
29 -0.12
0.16 0.59
自己効力感
2 87 47.40 9.91
46
47.04 10.38 26 73
47 0.32-0.58 1.06------------------------------------------------------------------------------------------------d1$入学年度: 20Y2
vars n mean
sd median trimmed
mad min max range skew kurtosisse
学習意欲
1 98 25.48 5.11
25.5
25.36 5.19 16 39
23 0.26-0.46 0.52
自己効力感
2 98 50.14 9.65
49.5
49.98 11.12 26 77
51 0.160.04 0.97------------------------------------------------------------------------------------------------d1$入学年度: 20Y3
vars n mean
sd median trimmed mad min max range skew kurtosisse
学習意欲
1 85 26.05 4.45
26
26.04 4.45 15 38
23 0.10-0.17 0.48
自己効力感
2 85 51.22 8.52
52
51.35 8.90 29 72
43 -0.14-0.34 0.92

> # describeByを使う方法> describeBy(d1[,c("学習意欲","自己効力感")], d1$入学年度)
Descriptive statistics by group
group: 20Y1
vars n mean
sd median trimmed
mad min max range skew kurtosisse
学習意欲
1 87 24.08 5.53
23
24.15 4.45
8 37
29 -0.12
0.16 0.59
自己効力感
2 87 47.40 9.91
46
47.04 10.38 26 73
47 0.32-0.58 1.06------------------------------------------------------------------------------------------------group: 20Y2
vars n mean
sd median trimmed
mad min max range skew kurtosisse
学習意欲
1 98 25.48 5.11
25.5
25.36 5.19 16 39
23 0.26-0.46 0.52
自己効力感
2 98 50.14 9.65
49.5
49.98 11.12 26 77
51 0.160.04 0.97------------------------------------------------------------------------------------------------group: 20Y3
vars n mean
sd median trimmed mad min max range skew kurtosisse
学習意欲
1 85 26.05 4.45
26
26.04 4.45 15 38
23 0.10-0.17 0.48
自己効力感
2 85 51.22 8.52
52
51.35 8.90 29 72
43 -0.14-0.34 0.92

> # mat=TRUEを指定して次のように表記することも可能> describeBy(d1[,c("学習意欲","自己効力感")], d1$入学年度, mat=TRUE, digits=2)
学習意欲1
学習意欲2
学習意欲3
自己効力感1
自己効力感2
自己効力感3

item group1 vars n mean
sd median trimmed
mad min max range skew kurtosis
se
1
20Y1
1 87 24.08 5.53
23.0
24.15 4.45
8 37
29 -0.12
0.16 0.59
2
20Y2
1 98 25.48 5.11
25.5
25.36 5.19 16 39
23 0.26-0.46 0.52
3
20Y3
1 85 26.05 4.45
26.0
26.04 4.45 15 38
23 0.10-0.17 0.48
4
20Y1
2 87 47.40 9.91
46.0
47.04 10.38 26 73
47 0.32-0.58 1.06
5
20Y2
2 98 50.14 9.65
49.5
49.98 11.12 26 77
51 0.160.04 0.97
6
20Y3
2 85 51.22 8.52
52.0
51.35 8.90 29 72
43 -0.14-0.34 0.92

154

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２要因以上の群別要約統計量
describeBy関数を使う方法
library(psych)
describeBy(変数名, list(群分け変数1, 群分け変数2, …), mat=TRUE, digits=2)
予めpsychパッケージをインストールしておく必要がある。
mat=TRUE というオプションを指定することにより，出力結果を行列表記にすることができる。

> # list()を使って群分け変数を入れ子状に設定することも可能> describeBy(d1[,c("学習意欲")], list(d1$入学年度, d1$学科), mat=TRUE, digits=2)
X11
X12
X13
X14
X15
X16
X17
X18
X19

item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
1
20Y1
医学
1 29 25.07 6.54
25.0
25.52 5.93
8 35
27 -0.72
0.09 1.21
2
20Y2
医学
1 27 26.81 5.95
26.0
26.61 5.93 17 39
22 0.04-0.76 1.14
3
20Y3
医学
1 20 27.50 3.87
28.0
27.44 4.45 22 35
13 0.06-1.35 0.87
4
20Y1 看護学
1 28 23.86 4.47
23.0
23.58 2.97 16 36
20 0.820.30 0.84
5
20Y2 看護学
1 33 24.52 4.33
25.0
24.48 4.45 16 36
20 0.18
0.09 0.75
6
20Y3 看護学
1 39 25.13 4.70
25.0
24.97 4.45 15 38
23 0.34
0.20 0.75
7
20Y1 心理学
1 30 23.33 5.40
23.0
23.33 4.45 12 37
25 0.15-0.13 0.99
8
20Y2 心理学
1 38 25.37 5.01
24.5
25.34 5.19 17 34
17 0.20-1.10 0.81
9
20Y3 心理学
1 26 26.31 4.28
26.0
26.36 4.45 17 35
18 0.01-0.49 0.84

> # 群分け変数2(学科)でまず群分けし，さらに，群分け変数1（年度）で群分けして，各群の記述統計量を> # 計算> # 記述統計量を計算する変数を1つ（学習意欲）しか設定していないので，変数名は X1 とされている。
> # X11 はその第1群，X12はその第2群，という変数表示になっている。

> # 記述統計量を計算する変数を2つ以上かけば，変数名に数字がついて表示される。
> # 変数が2つ以上ある場合>> describeBy(d1[,c("学習意欲","自己効力感")], list(d1$入学年度, d1$学科), mat=TRUE, digits=2)
学習意欲1
学習意欲2
学習意欲3
学習意欲4
学習意欲5
学習意欲6
学習意欲7
学習意欲8
学習意欲9
自己効力感1
自己効力感2
自己効力感3
自己効力感4
自己効力感5
自己効力感6
自己効力感7
自己効力感8自己効力感9>item group1 group2 vars n mean
sd median trimmed
mad min max range skew kurtosis
se
1
20Y1
医学
1 29 25.07 6.54
25.0
25.52 5.93
8 35
27 -0.72
0.09 1.21
2
20Y2
医学
1 27 26.81 5.95
26.0
26.61 5.93 17 39
22 0.04-0.76 1.14
3
20Y3
医学
1 20 27.50 3.87
28.0
27.44 4.45 22 35
13 0.06-1.35 0.87
4
20Y1 看護学
1 28 23.86 4.47
23.0
23.58 2.97 16 36
20 0.820.30 0.84
5
20Y2 看護学
1 33 24.52 4.33
25.0
24.48 4.45 16 36
20 0.18
0.09 0.75
6
20Y3 看護学
1 39 25.13 4.70
25.0
24.97 4.45 15 38
23 0.34
0.20 0.75
7
20Y1 心理学
1 30 23.33 5.40
23.0
23.33 4.45 12 37
25 0.15-0.13 0.99
8
20Y2 心理学
1 38 25.37 5.01
24.5
25.34 5.19 17 34
17 0.20-1.10 0.81
9
20Y3 心理学
1 26 26.31 4.28
26.0
26.36 4.45 17 35
18 0.01-0.49 0.84
10
20Y1
医学
2 29 49.76 9.83
50.0
49.32 11.86 35 73
38 0.41-0.83 1.83
11
20Y2
医学
2 27 50.26 10.81
52.0
50.87 8.90 26 73
47 -0.50-0.01 2.08
12
20Y3
医学
2 20 56.00 7.67
54.5
55.75 8.15 41 72
31 0.20-0.69 1.72
13
20Y1 看護学
2 28 45.68 8.67
45.0
44.96 5.93 33 68
35 0.970.51 1.64
14
20Y2 看護学
2 33 50.55 10.71
49.0
49.85 11.86 34 77
43 0.55-0.43 1.86
15
20Y3 看護学
2 39 50.38 8.11
52.0
50.48 8.90 35 65
30 -0.14-1.08 1.30
16
20Y1 心理学
2 30 46.73 10.91
47.5
46.92 14.08 26 66
40 -0.09-1.22 1.99
17
20Y2 心理学
2 38 49.71 7.90
48.5
49.41 9.64 38 70
32 0.37-0.69 1.28
18
20Y3 心理学
2 26 48.81 8.58
49.5
48.95 6.67 29 65
36 -0.28-0.31 1.68

155

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

共分散・相関係数
不偏共分散行列（n-1で割る）
cov(データフレーム名)
相関係数行列cor(データフレーム名, method="算出方法", use="欠測値の扱い方法")
method："pearson" (default), "spearman", or "kendall"
use: "everything"
当該2変数に欠測値がある場合，その箇所の値だけNAとなる．
"complete.obs"
1つでも欠測値のある行を除外してすべての値を計算．
"pairwise.complete.obs" 当該2変数に欠測値がある場合，その箇所だけ欠測値を除外して計算．

> setwd("d:\\")> d1 <- read.table("偏相関データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)grade kutsu math
1
3
21
49
2
2
20
36
3
3
20
47
4
3
20
54
5
6
26
73
6
1
17
2
>
> # 共分散> cov(d1)
grade
kutsu
math
grade 2.926421 4.573579 30.80100
kutsu 4.573579 9.073567 47.37457
math 30.801003 47.374571 400.18394>> # ピアソンの積率相関係数> cor(d1)
grade
kutsu
math
grade 1.0000000 0.887562 0.9000499
kutsu 0.8875620 1.000000 0.7861880
math 0.9000499 0.786188 1.0000000># grade の分散 = 2.926421# grade と kutsu の共分散 = 4.573579# kutsu と math の共分散 = 47.47457# grade と kutsu の相関係数 = 0.887562# kutsu と math の相関係数 = 0.9000499> # スピアマンの順位相関係数> cor(d1, method="spearman")
grade
kutsu
math
grade 1.0000000 0.9004303 0.9094415
kutsu 0.9004303 1.0000000 0.8158021
math 0.9094415 0.8158021 1.0000000>> # ケンドールの順位相関係数> cor(d1, method="kendall")
grade
kutsu
math
grade 1.0000000 0.7881925 0.7766475
kutsu 0.7881925 1.0000000 0.6314266
math 0.7766475 0.6314266 1.0000000
>
>

156

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

群別の共分散・相関係数
不偏共分散行列（n-1で割る）
by(データフレーム名, 群別変数名, cov)
相関係数行列by(データフレーム名, 群別変数名, cor, use="欠測値の扱い方法")
method："pearson" (default), "spearman", or "kendall"
use: "everything"
当該2変数に欠測値がある場合，その箇所の値だけNAとなる．
"complete.obs"
1つでも欠測値のある行を除外してすべての値を計算．
"pairwise.complete.obs" 当該2変数に欠測値がある場合，その箇所だけ欠測値を除外して計算．
データフレームは，群別変数も含めた必要な変数だけにしておく．

> setwd("d:\\")> d1 <- read.table("偏相関データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)grade kutsu math
1
3
21
49
2
2
20
36
3
3
20
47
4
3
20
54
5
6
26
73
6
1
17
2
>
>
> # 各群の標本サイズ> table(d1$grade)1 2 3 4 5 650 50 50 50 50 50>> # 各群の平均> aggregate(d1[,c("kutsu", "math")], list(d1$grade), mean)
Group.1 kutsu math1
1 17.22 23.64
22 18.54 32.58
3
3 20.26 46.54
4
4 21.64 55.50
55 23.38 66.72
6
6 24.98 75.04>> # 各群のSD> sapply(d1[,c("kutsu", "math")], tapply, d1$grade, sd)
kutsu
math
1 1.266362 11.035675
2 1.501156 6.931413
3 1.208980 8.447219
4 1.396205 8.576784
5 1.496799 7.946351
6 1.477588 8.787654>> # 各群の共分散行列> by(d1[,c("kutsu", "math")], d1$grade, cov)
d1$grade: 1
kutsu
math
kutsu 1.603673 -2.164082
math -2.164082 121.786122--------------------------------------------------------------------------------------157

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

d1$grade: 2
kutsu
math
kutsu 2.253469 -2.748163
math -2.748163 48.044490--------------------------------------------d1$grade: 3
kutsu
math
kutsu 1.4616327 -0.6534694
math -0.6534694 71.3555102--------------------------------------------d1$grade: 4
kutsu
math
kutsu 1.949388 2.591837
math 2.591837 73.561224--------------------------------------------d1$grade: 5
kutsu
math
kutsu 2.2404082 -0.8914286
math -0.8914286 63.1444898---------------------------------------------d1$grade: 6
kutsu
math
kutsu 2.1832653 -0.9583673
math -0.9583673 77.2228571>> # 各群の相関係数行列> by(d1[,c("kutsu", "math")], d1$grade, cor)
d1$grade: 1
kutsu
math
kutsu 1.000000 -0.154852
math -0.154852 1.000000--------------------------------------------d1$grade: 2
kutsu
math
kutsu 1.0000000 -0.2641161
math -0.2641161 1.0000000--------------------------------------------d1$grade: 3
kutsu
math
kutsu 1.00000000 -0.06398709
math -0.06398709 1.00000000---------------------------------------------d1$grade: 4
kutsu
math
kutsu 1.0000000 0.2164383
math 0.2164383 1.0000000---------------------------------------------d1$grade: 5
kutsu
math
kutsu 1.00000000 -0.07494717
math -0.07494717 1.00000000---------------------------------------------d1$grade: 6
kutsu
math
kutsu 1.0000000 -0.0738084
math -0.0738084 1.0000000>>>> # 重ね合わせ散布図> plot(d1$kutsu, d1$math, pch="", axes=T, xlim=c(14, 30), ylim=c(0,95),+
xlab="kutsu", ylab="math")> text(d1$kutsu, d1$math, labels=d1$grade, cex=0.8)

158名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

偏相関係数
影響を除く変数を指定した偏相関係数
library(psych)
partial.r(data, c(偏相関係数を求めたい変数群の列番号), c(影響を除きたい変数群の列番号))
あらかじめpsychパッケージをインストールしておく必要がある．
data はデータフレームでもよいし，相関係数行列でもよい．
偏相関係数を求めたい変数が2つ以上ある場合は，列番号をカンマで区切る．
影響を除きたい変数が2つ以上ある場合は，列番号をカンマで区切る．
当該の2変数以外の全ての変数の影響を除いた偏相関係数行列
library(corpcor)
cor2pcor(相関係数行列)
あらかじめcorpcorパッケージをインストールしておく必要がある．

> setwd("d:\\")> d1 <- read.table("偏相関データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)grade kutsu math
1
3
21
49
2
2
20
36
3
3
20
47
4
3
20
54
5
6
26
73
6
1
17
2
>
>
> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD grade kutsu math
grade 300 3.5 1.71 1.00 0.89 0.90
kutsu 300 21.0 3.01 0.89 1.00 0.79
math 300 50.0 20.00 0.90 0.79 1.00>> # 偏相関係数> library(psych)> partial.r(d1, c(2,3), c(1))
partial correlations
kutsu mathkutsu 1.00 -0.06
math -0.06 1.00
> partial.r(d1, c(1,3), c(2))
partial correlations
grade math
grade 1.00 0.71
math
0.71 1.00> partial.r(d1, c(1,2), c(3))
partial correlations
grade kutsu
grade 1.00 0.67
kutsu 0.67 1.00>
159

名古屋 大学> # 当該の2変数以外の全ての変数の影響を除いた偏相関係数>> #corpcorパッケージのcor2pcor関数を使う方法> library(corpcor)> cor2pcor(ctmp)
[,1]
[,2]
[,3]
[1,] 1.0000000 0.6682002 0.7104308[2,] 0.6682002 1.0000000 -0.0630700[3,] 0.7104308 -0.0630700 1.0000000

160

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

四分相関係数・多分相関係数
library(psych)
library(polycor)
オブジェクト名1 <- polychoric(データフレーム名)
相関係数行列だけの取り出し
オブジェクト名1$rho
あらかじめpsychとpolycorパッケージをインストールしておく必要がある．
データフレーム以外に，テーブルを代入したりすることもできる．

> setwd("d:\\")> d1 <- read.table("２値_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)x1 x2 x3 x4 x5 x6 x7 x8
1 0 0 1 1 1 0 0 1
2 0 0 1 1 0 0 1 0
3 0 0 0 0 0 0 0 0
4 0 1 0 0 1 0 1 1
5 0 1 1 1 1 1 0 1
6 0 0 0 1 0 0 1 0>> # 標本サイズ，平均，標準偏差> dtmp <- d1> ntmp <- nrow(d1)> mtmp <- apply(d1, 2, mean)> stmp <- apply(d1, 2, sd)> ktmp <- round(data.frame(ntmp, mtmp, stmp),2)> colnames(ktmp) <- c("N","Mean","SD")> ktmpN Mean SD
x1 346 0.48 0.5
x2 346 0.54 0.5
x3 346 0.51 0.5
x4 346 0.53 0.5
x5 346 0.49 0.5
x6 346 0.53 0.5
x7 346 0.53 0.5
x8 346 0.51 0.5>
> #積率相関係数> round(cor(dtmp), 2)
x1
x2
x3
x4
x5
x6
x7
x8
x1 1.00 0.18 0.25 0.16 0.03 0.05 0.05 0.01
x2 0.18 1.00 0.19 0.05 0.07 0.07 0.01 0.10
x3 0.25 0.19 1.00 0.14 0.09 0.04 0.03 0.07
x4 0.16 0.05 0.14 1.00 0.07 0.01 -0.02 0.00
x5 0.03 0.07 0.09 0.07 1.00 0.13 0.17 0.24
x6 0.05 0.07 0.04 0.01 0.13 1.00 0.10 0.03
x7 0.05 0.01 0.03 -0.02 0.17 0.10 1.00 0.12
x8 0.01 0.10 0.07 0.00 0.24 0.03 0.12 1.00>>

> #四分相関係数・多分相関係数> library(psych)> library(polycor)

161名古屋 大学> (ptcor.d1 <- polychoric(d1))
Call: polychoric(x = d1)
Polychoric correlations
x1
x2
x3
x4
x5
x6
x7
x8
x1 1.00
x2 0.28 1.00
x3 0.38 0.29 1.00
x4 0.25 0.07 0.22 1.00
x5 0.05 0.11 0.15 0.11 1.00
x6 0.08 0.10 0.07 0.01 0.21 1.00
x7 0.09 0.02 0.04 -0.03 0.27 0.16 1.00
x8 0.02 0.16 0.11 0.00 0.36 0.04 0.18 1.00
with tau of0
x1 0.051
x2 -0.094
x3 -0.036
x4 -0.080
x5 0.014
x6 -0.073
x7 -0.065
x8 -0.014>> # 相関係数行列だけの取り出し> pcor.d1 <- ptcor.d1$rho> round(pcor.d1, 2)
x1
x2
x3
x4
x5
x6
x7
x8
x1 1.00 0.28 0.38 0.25 0.05 0.08 0.09 0.02
x2 0.28 1.00 0.29 0.07 0.11 0.10 0.02 0.16
x3 0.38 0.29 1.00 0.22 0.15 0.07 0.04 0.11
x4 0.25 0.07 0.22 1.00 0.11 0.01 -0.03 0.00
x5 0.05 0.11 0.15 0.11 1.00 0.21 0.27 0.36
x6 0.08 0.10 0.07 0.01 0.21 1.00 0.16 0.04
x7 0.09 0.02 0.04 -0.03 0.27 0.16 1.00 0.18
x8 0.02 0.16 0.11 0.00 0.36 0.04 0.18 1.00
>
>

162

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

アルファ係数変数リスト名 <- c("変数名1", "変数名2", …, "変数名p")library(psych)alpha(データフレーム名[,変数リスト名])
あらかじめpsychパッケージをインストールしておく必要がある．
出力内容
total
raw_alphastd.alphaG6(smc)average_r
median_r
mean
sdalpha.drop
item.stats
n
raw.r
std.r
r.cor
r.dropmean
sd
response.freq
scoresboot.ciboot
UnidimFit

a list containingalpha based upon the covariances
The standarized alpha based upon the correlations
Guttman's Lambda 6 reliability
The average interitem correlation
The median interitem correlation
For data matrices, the mean of the scale formed by averaging or summing the items(depending upon the cumulative option)
For data matrices, the standard deviation of the total score
A data frame with all of the above for the case of each item being removed one by one.
A data frame including
number of complete cases for the item
The correlation of each item with the total score, not corrected for item overlap.
The correlation of each item with the total score (not corrected for item overlap) if theitems were all standardized
Item whole correlation corrected for item overlap and scale reliability
Item whole correlation for this item against the scale without this item
for data matrices, the mean of each item
For data matrices, the standard deviation of each item
For data matrices, the frequency of each item response (if less than 20)
Scores are by default simply the average response for all items that a participant took.
If cumulative=TRUE, then these are sum scores. Note, this is dangerous if there arelots of missing values.
The lower, median, and upper ranges of the 95% confidence interval based upon thebootstrap.
a 6 column by n.iter matrix of boot strapped resampled values
An index of unidimensionality
The fit of the off diagonal matrix

coefficientパッケージの中にもα係数を求めるalphaという関数があるが，項目分析をやってくれない．

> setwd("d:\\")> d1 <- read.table("統計分析力尺度データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
1
2
3
4
5
6
1
2
3
4
5
6
>

番号 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 xt yt
1 3 2 1 2 2 4 4 3 4
4 3 2 1 2 1 4 3 3 3
4 29 26
2 3 3 4 3 2 2 2 2 4
1 2 2 4 2 2 1 1 1 3
1 26 19
3 4 3 3 4 1 3 4 2 5
1 4 3 4 4 1 3 4 2 5
1 30 31
4 5 5 5 3 3 4 4 2 4
4 5 4 5 2 2 3 4 2 3
3 39 33
5 3 3 4 2 2 3 3 3 4
1 3 4 4 3 2 4 3 4 5
1 28 33
6 2 1 4 1 1 3 3 2 5
1 3 2 4 2 2 5 4 3 5
2 23 32
統計 数学 批判的思考力 国語 自己効力感
51
48
28
72
61
74
53
26
66
53
48
60
35
71
48
67
68
27
67
48
55
49
30
66
49
74
63
36
83
37

> #変数リスト名> inames <- c("x1", "x2", "x3", "x4", "x5","x6", "x7", "x8", "x9", "x10")163

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #α係数の推定> library(psych)> alpha(d1[,inames])
Reliability analysis
Call: alpha(x = d1[, inames], check.keys = FALSE)
raw_alpha std.alpha G6(smc) average_r S/N ase mean
sd
0.84
0.84
0.84
0.35 5.3 0.02 3.1 0.61
lower alpha upper
0.8 0.84 0.88

95% confidence boundaries

Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N alpha se
x1
0.82
0.82
0.82
0.34 4.7
0.022
x2
0.82
0.82
0.82
0.34 4.6
0.022
x3
0.83
0.83
0.83
0.34 4.7
0.022
x4
0.82
0.82
0.82
0.34 4.6
0.022
x5
0.82
0.82
0.82
0.34 4.6
0.022
x6
0.82
0.82
0.82
0.34 4.7
0.022
x7
0.83
0.83
0.83
0.35 4.8
0.022
x8
0.83
0.83
0.83
0.35 4.8
0.022
x9
0.83
0.83
0.83
0.35 4.9
0.022
x10
0.83
0.83
0.83
0.36 5.0
0.022
Item statisticsnr r.cor r.drop meansd
x1 365 0.67 0.62
0.57 4.0 0.92
x2 365 0.67 0.63
0.57 3.1 0.96x3 365 0.65 0.60
0.54 4.1 0.85
x4 365 0.68 0.64
0.57 3.0 1.07
x5 365 0.67 0.63
0.57 2.2 0.93
x6 365 0.65 0.61
0.54 3.0 1.01
x7 365 0.62 0.56
0.51 3.1 0.99
x8 365 0.63 0.58
0.53 2.2 0.89
x9 365 0.59 0.52
0.48 3.9 0.90
x10 365 0.57 0.51
0.46 2.1 0.95
Non missing response frequency for each item
12
3
4
5 missx1 0.01 0.05 0.23 0.36 0.35
0x2 0.04 0.22 0.42 0.25 0.07
0x3 0.01 0.03 0.22 0.40 0.35
0x4 0.09 0.23 0.36 0.24 0.08
0x5 0.25 0.41 0.25 0.09 0.01
0x6 0.06 0.24 0.38 0.25 0.07
0x7 0.05 0.22 0.36 0.30 0.07
0x8 0.25 0.42 0.25 0.07 0.00
0x9 0.01 0.06 0.24 0.40 0.29
0x10 0.30 0.37 0.25 0.08 0.01
0>アルファ係数の警告メッセージについて
アルファ係数を求めるにあたって，次のような警告メッセージが出ることがあります。
Some items (…) were negatively correlated with the total scale and probably should be reversed.
To do this, run the function again with the 'check.keys=TRUE' option Reliability analysis
これは，いわゆる逆転項目が混入している疑いがあるというメッセージです。他の多くの項目と負の相関がある項目があるということです。
対処法としては，実際に逆転項目であれば，得点の変換（逆転処理）を行ってアルファ係数を求めるようにします。逆転項目でなければ，いま出ている結果を受け入れることになります。
逆転処理後のアルファ係数を求めるオプション設定として check.keys=TRUE があります。これは，逆転項
目の疑いがある変数について，自動で得点変換を行ってアルファ係数を算出するものですが，元のデータを変換する訳ではないので，このオプションを使うのは，お勧めできません。
164

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

オメガ係数
変数リスト名 <- c("変数名1", "変数名2", …, "変数名p")library(coefficientalpha)
オブジェクト名 < - omega(データフレーム名[,変数リスト名], se=TRUE)
summary.omega(オブジェクト名)
あらかじめcoefficientalphaパッケージをインストールしておく必要がある．
se=TRUEをつけておかないと，summary.omegaで信頼区間を計算してくれない．
逆転項目は，あらかじめスコアを正しい方向に修正しておく必要がある．
psychパッケージにもomegaという関数があるが，因子分析を使うものである．

> setwd("d:\\")> d1 <- read.table("統計分析力尺度データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 xt yt
1
1 3 2 1 2 2 4 4 3 4
4 3 2 1 2 1 4 3 3 3
4 29 262
2 3 3 4 3 2 2 2 2 4
1 2 2 4 2 2 1 1 1 3
1 26 193
3 4 3 3 4 1 3 4 2 5
1 4 3 4 4 1 3 4 2 5
1 30 314
4 5 5 5 3 3 4 4 2 4
4 5 4 5 2 2 3 4 2 3
3 39 335
5 3 3 4 2 2 3 3 3 4
1 3 4 4 3 2 4 3 4 5
1 28 33
6
6 2 1 4 1 1 3 3 2 5
1 3 2 4 2 2 5 4 3 5
2 23 32
統計 数学 批判的思考力 国語 自己効力感
1
51
48
28
72
61
2
74
53
26
66
53
3
48
60
35
71
48
4
67
68
27
67
48
5
55
49
30
66
49
6
74
63
36
83
37
>
> #変数リスト名> inames <- c("x1", "x2", "x3", "x4", "x5",+"x6", "x7", "x8", "x9", "x10")> # omega 係数の推定> library(coefficientalpha)> o1 <- omega(d1[,inames], se=T)
Test of homogeneity
The robust F statistic iswith a p-value 0

3.288**The F test rejected homogeneity**
The omega is 0.8409224 with the standard error 0.01255086.
About 6.85% of cases were downweighted.
> # 信頼区間の計算> summary.omega(o1)The estimated omega isomega
sep-value (omega>0)
Confidence interval

0.841
0.013
0.000
0.816

0.866

Test of homogeneity
The robust F statistic is 3.288
with a p-value 0
Note. The robust test rejected the assumption of165

homogeneity.

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

級内相関係数
library(psych)
ICC(データフレーム名)
あらかじめpsychパッケージをインストールしておく必要がある．
ICC1：被験者内要因（k回評定）の効果を誤差に含めるモデルにおける，評定の一致度
ICC2：被験者内要因（k回評定）の効果を変量効果とするモデルにおける，評定の一致度
ICC3：被験者内要因（k回評定）の効果を固定効果とするモデルにおける，評定の一致度
ICC1k：被験者内要因（k回評定）の効果を誤差に含めるモデルにおける，k回評定の平均値の信頼性
ICC2k：被験者内要因（k回評定）の効果を変量効果とするモデルおける，k回評定の平均値の信頼性
ICC3k：被験者内要因（k回評定）の効果を固定効果とするモデルおける，k回評定の平均値の信頼性> setwd("d:\\")> d1 <- read.table("統計分析力尺度データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 xt yt
1
1 3 2 1 2 2 4 4 3 4
4 3 2 1 2 1 4 3 3 3
4 29 262
2 3 3 4 3 2 2 2 2 4
1 2 2 4 2 2 1 1 1 3
1 26 193
3 4 3 3 4 1 3 4 2 5
1 4 3 4 4 1 3 4 2 5
1 30 314
4 5 5 5 3 3 4 4 2 4
4 5 4 5 2 2 3 4 2 3
3 39 335
5 3 3 4 2 2 3 3 3 4
1 3 4 4 3 2 4 3 4 5
1 28 33
6
6 2 1 4 1 1 3 3 2 5
1 3 2 4 2 2 5 4 3 5
2 23 32
統計 数学 批判的思考力 国語 自己効力感
1
51
48
28
72
61
2
74
53
26
66
53
3
48
60
35
71
48
4
67
68
27
67
48
5
55
49
30
66
49
6
74
63
36
83
37
>
> #変数リスト名> inames <- c("x1", "x2", "x3", "x4", "x5",+"x6", "x7", "x8", "x9", "x10")>>> # 級内相関係数の推定> library(psych)> ICC(d1[,inames])
Call: ICC(x = d1[, inames])
Intraclass correlation coefficients
type ICC
F df1 df2 p lower bound upper boundSingle_raters_absolute
ICC1 0.18 3.2 364 3285 0
0.15
0.22
Single_random_raters
ICC2 0.21 6.3 364 3276 0
0.13
0.29
Single_fixed_raters
ICC3 0.34 6.3 364 3276 0
0.31
0.39
Average_raters_absolute ICC1k 0.69 3.2 364 3285 0
0.64
0.73
Average_random_raters
ICC2k 0.73 6.3 364 3276 0
0.61
0.81
Average_fixed_raters
ICC3k 0.84 6.3 364 3276 0
0.81
0.86
Number of subjects = 365

Number of Judges =10>> # ICC3Kはα係数に等しい> library(psych)> alpha(d1[,inames])
Reliability analysis
Call: alpha(x = d1[, inames], check.keys = FALSE)
raw_alpha std.alpha G6(smc) average_r S/N ase mean
sd
0.84
0.84
0.84
0.35 5.3 0.02 3.1 0.61
lower alpha upper
0.8 0.84 0.88

95% confidence boundaries

166名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

１群の平均値の推測
t.test(平均値を比較する変数, mu=母平均値)
母平均値 mu=0 の場合は「mu=0」を省略することもできる> setwd("d:\\")> d1 <- read.table("1群の平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id score
1 1
116
2 2
105
3 3
102
4 4
104
5 5
93
6 6
111
>
>
> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN
Mean
SD
id scoreid
50 25.50 14.58 1.00 0.25
score 50 108.72 15.07 0.25 1.00>>
> # 「H0: μ0=100」の検定> t.test(d1$score, mu=100)
One Sample t-test
data: d1$score
t = 4.0916, df = 49, p-value = 0.0001593
alternative hypothesis: true mean is not equal to 100
95 percent confidence interval:
104.4372 113.0028
sample estimates:
mean of x108.72>>> # 「H0: μ0=95」の検定> t.test(d1$score, mu=95)
One Sample t-test
data: d1$score
t = 6.4376, df = 49, p-value = 4.933e-08
alternative hypothesis: true mean is not equal to 95
95 percent confidence interval:
104.4372 113.0028
sample estimates:
mean of x108.72167

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のある２群の平均値の比較
t.test(平均値を比較する変数１, 平均値を比較する変数２, paired=TRUE)
paired=TRUE で対応のある検定であることを指定．これは省略できない．

> setwd("d:\\")> d1 <- read.table("対応のある2群の平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
教養科目 専門科目
1
17
18
2
16
14
3
16
18
4
16
15
5
18
18
6
21
20
>
>
> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean
SD 教養科目 専門科目
教養科目 237 16.72 2.12
1.00
0.43
専門科目 237 17.01 2.40
0.43
1.00
>
>
>
> # 対応のある平均値の差の検定（対応のあるｔ検定）を行う> t.test(d1$教養科目, d1$専門科目, paired=TRUE)
Paired t-test
data: d1$教養科目 and d1$専門科目
t = -1.8515, df = 236, p-value = 0.06534
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:-0.6009154 0.0186369
sample estimates:
mean of the differences-0.2911392>

168

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のある２群の平均値差の効果量の推定
effectsizeパッケージのcohens_dまたはhedges_g関数を使う方法
library(effectsize)
cohens_d(変数1, 変数2, paired=TRUE)
cohens_d(Pair(変数1, 変数2)~1, data=データフレーム名)
hedges_g(変数1, 変数2, paired=TRUE
hedges_g(Pair(変数1, 変数2)~1, data=データフレーム名)
あらかじめeffectsizeパッケージをインストールしておく必要がある．
cohens_d はコーエンのd，hedges_g はヘッジズのgを求める。

> setwd("d:\\")> d1 <- read.table("対応のある2群の平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
教養科目 専門科目
1
17
18
2
16
14
3
16
18
4
16
15
5
18
18
6
21
20
>
>
>
> # 各群の記述統計量> library(psych)> (stats <- describe(d1[,c("教養科目","専門科目")]))
vars
n meansd median trimmed mad min max range skew kurtosisse
教養科目
1 237 16.72 2.12
17
16.73 2.97 12 21
9 -0.09-0.57 0.14
専門科目
2 237 17.01 2.40
1717.01 2.97 10 24
14 0.00-0.14 0.16>>>>
> # 効果量の推定>> # effectsizeパッケージのcohens_dまたはhedges_g関数を使う方法> library(effectsize)>> cohens_d(d1$教養科目,d1$専門科目, paired=TRUE)
Cohen's d |95% CI-------------------------0.12| [-0.25, 0.01]>> cohens_d(Pair(d1[,"教養科目"], d1[,"専門科目"])~1, data=d1)
Cohen's d |95% CI-------------------------0.12| [-0.25, 0.01]>>> hedges_g(d1$教養科目,d1$専門科目, paired=TRUE)
Hedges' g |95% CI-------------------------0.12| [-0.25, 0.01]>> hedges_g(Pair(d1[,"教養科目"], d1[,"専門科目"])~1, data=d1)
Hedges' g |95% CI-------------------------0.12| [-0.25, 0.01]

169

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のない２群の平均値の比較 － 素データ
t.test(平均値を比較する変数 ~ 群分け変数, データフレーム名, paired=FALSE)
t.test(平均値を比較する変数１, 平均値を比較する変数２, paired=FALSE)またはpaired=FALSE で対応のない検定であることを指定．これは省略することも可能．

> setwd("d:\\")> d1 <- read.table("対応のない2群の平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号
説明 不安
1
1 ビデオ
32
2
2 ビデオ
23
3
3 ビデオ
28
4
4 ビデオ
29
5
5 ビデオ
20
6
6 ビデオ
33
>
>
> # 記述統計量> library(psych)> describeBy(d1[,c("不安")], d1$説明)
group: ビデオ
vars
n meansd median trimmed mad min max range skew kurtosis
se1
1 103 27.04 4.32
27
27.12 4.45 17 37
20 -0.1-0.44 0.43--------------------------------------------------------group: 看護師
vars n mean
sd median trimmed mad min max range skew kurtosis
se1
1 94 25.44 6.22
25
25.43 5.93
9 40
31 -0.03-0.15 0.64>>
> # 対応のない2群の平均値の検定> # 等分散性を仮定しない場合> t.test(不安 ~ 説明, d1, paired=FALSE)
Welch Two Sample t-test
data: 不安 by 説明t = 2.082, df = 163.823, p-value = 0.0389
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
0.08272468 3.12260480
sample estimates:
mean in group ビデオ mean in group 看護師
27.03883
25.43617>> # 等分散性を仮定した場合> t.test(不安 ~ 説明, d1, paired=FALSE, var.equal=TRUE)
Two Sample t-test
data: 不安 by 説明t = 2.1158, df = 195, p-value = 0.03563
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
0.1087512 3.0965783
sample estimates:
mean in group ビデオ mean in group 看護師
27.03883
25.43617170

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のない２群の平均値の比較 － 要約統計量
各群の人数，平均，標準偏差（n1, m1, s1, n2, m2, s2）を求め，以下の式に代入
dm <- m1 - m2
df <- n1 + n2 - 2
se <- sqrt(((n1-1)*s1*s1+(n2-1)*s2*s2)/(n1 + n2-2)*(1/n1 + 1/n2))tValue <- dm/se
pValue <- 2 *(1 - pt(abs(tValue),df))
t95 <- qt(0.975, df)
L95 <- dm - t95 * se
U95 <- dm + t95 * sedata.frame(m1, m2, dm, df, tValue, pValue, L95, U95)
先行研究等で，要約統計量しか分からないデータであっても，この方法を使えば，平均値の比較ができる．
先行研究を対照群に設定するときなどに，この計算方法を用いると良い．

> setwd("d:\\")> d1 <- read.table("対応のない2群の平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号
説明 不安
1
1 ビデオ
32
2
2 ビデオ
23
3
3 ビデオ
28
4
4 ビデオ
29
5
5 ビデオ
20
6
6 ビデオ
33

> # 各群のデータを抽出> data1 <- d1[d1$説明=="ビデオ", "不安"]> data2 <- d1[d1$説明=="看護師", "不安"]>>> # 記述統計量> (n1 <- length(data1))[1] 103> (m1 <- mean(data1))[1] 27.03883> (s1 <- sd(data1))[1] 4.315777> (n2 <- length(data2))[1] 94> (m2 <- mean(data2))[1] 25.43617> (s2 <- sd(data2))[1] 6.220947
>
>
>
>
>
>
>
>
>
>
>
>

# 平均値の差の検定，信頼区間
dm <- m1 - m2
df <- n1 + n2 - 2
se <- sqrt(((n1-1)*s1*s1+(n2-1)*s2*s2)/(n1 + n2-2)*(1/n1 + 1/n2))tValue <- dm/se
pValue <- 2 *(1 - pt(abs(tValue),df))
t95 <- qt(0.975, df)
L95 <- dm - t95 * se
U95 <- dm + t95 * sedata.frame(m1, m2, dm, df, tValue, pValue, L95, U95)

m1
m2
dm df
tValuepValueL95
U95
1 27.03883 25.43617 1.602665 195 2.115773 0.03563318 0.1087512 3.096578>

171名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のない２群の平均値差の効果量の推定
compute.esパッケージのmesまたはmes2関数を使う方法
library(compute.es)mes(m.1=m1, m.2=m2, sd.1=s1, sd.2=s2, n.1=n1, n.2=n2)
s.pool <- sqrt((n1*s1^2+n2*s2^2)/(n1+n2-2))
mes2(m.1=m1, m.2=m2, s.pooled=s.pool, n.1=n1, n.2=n2)
あらかじめcompute.esパッケージをインストールしておく必要がある．
mesは2群のSDの値が分かっているとき，mes2はプールされたSDしか分からないときに使う．
mesもmes2も，プールされたSDを分母に使う．

effectsizeパッケージのcohens_dまたはhedges_g関数を使う方法
library(effectsize)
cohens_d(変数~群分け変数, data=データフレーム名)
cohens_d(変数~群分け変数, data=データフレーム名, pooled_sd=FALSE)
hedges_g(変数~群分け変数, data=データフレーム名)
hedges_g(変数~群分け変数, data=データフレーム名, pooled_sd=FALSE)
あらかじめeffectsizeパッケージをインストールしておく必要がある．
cohens_d はコーエンのd，hedges_g はヘッジズのgを求める。
pooled_sd=FALSE とすると，プールされたSDではなく，各群のSDの平均値をSDの値として用いる。

> setwd("d:\\")> d1 <- read.table("対応のない2群の平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号
説明 不安
1
1 ビデオ
26
2
2 看護師
24
3
3 ビデオ
29
4
4 看護師
23
5
5 ビデオ
25
6
6 看護師
23
>
>
> # 各群の記述統計量> library(psych)> (stats <- describeBy(d1[,c("不安")], list(d1$説明), mat=TRUE, digits=2))
item group1 vars
n meansd median trimmed mad min max range skew kurtosis
se
X11
1 ビデオ
1 103 27.04 4.32
27
27.12 4.45 17 37
20 -0.10-0.44 0.43
X12
2 看護師
1 94 25.44 6.22
25
25.43 5.93
9 40
31 -0.03-0.15 0.64>>
> # 記述統計量の保存> (m1 <- stats$mean[1])[1] 27.04> (s1 <- stats$sd[1])[1] 4.32> (n1 <- stats$n[1])[1] 103> (m2 <- stats$mean[2])[1] 25.44> (s2 <- stats$sd[2])[1] 6.22> (n2 <- stats$n[2])[1] 94>172

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 対応のない2群の平均値の検定> # 等分散性を仮定した場合> (res1 <- t.test(data1, data2, paired=FALSE, var.equal=TRUE))
Two Sample t-test
data: data1 and data2
t = 2.1158, df = 195, p-value = 0.03563
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
0.1087512 3.0965783
sample estimates:
mean of x mean of y27.03883 25.43617> # 効果量の推定> # compute.esパッケージのmesまたはmes2関数を使う方法> library(compute.es)> mes(m.1=m1, m.2=m2, sd.1=s1, sd.2=s2, n.1=n1, n.2=n2)
Mean Differences ES:
d [ 95 %CI] = 0.3 [ 0.02 , 0.58 ]var(d) = 0.02
p-value(d) = 0.04
U3(d) = 61.86 %CLES(d) = 58.45 %Cliff's Delta = 0.17
g [ 95 %CI] = 0.3 [ 0.02 , 0.58 ]var(g) = 0.02
p-value(g) = 0.04
U3(g) = 61.82 %CLES(g) = 58.42 %Correlation ES:
r [ 95 %CI] = 0.15 [ 0.01 , 0.28 ]var(r) = 0
p-value(r) = 0.04
z [ 95 %CI] = 0.15 [ 0.01 , 0.29 ]var(z) = 0.01
p-value(z) = 0.04
Odds Ratio ES:
OR [ 95 %CI] = 1.73 [ 1.03 , 2.89 ]p-value(OR) = 0.04
Log OR [ 95 %CI] = 0.55 [ 0.03 , 1.06 ]var(lOR) = 0.07
p-value(Log OR) = 0.04
Other:
NNT = 10.56
Total N = 197> # プールされたSDを使う方法> s.pool <- sqrt((n1*s1^2+n2*s2^2)/(n1+n2-2))> mes2(m.1=m1, m.2=m2, s.pooled=s.pool, n.1=n1, n.2=n2)
Mean Differences ES:
d [ 95 %CI] = 0.3 [ 0.02 , 0.58 ]var(d) = 0.02
p-value(d) = 0.04
U3(d) = 61.8 %CLES(d) = 58.41 %Cliff's Delta = 0.17173

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

g [ 95 %CI] = 0.3 [ 0.02 , 0.58 ]var(g) = 0.02
p-value(g) = 0.04
U3(g) = 61.76 %CLES(g) = 58.37 %Correlation ES:
r [ 95 %CI] = 0.15 [ 0.01 , 0.28 ]var(r) = 0
p-value(r) = 0.04
z [ 95 %CI] = 0.15 [ 0.01 , 0.29 ]var(z) = 0.01
p-value(z) = 0.04
Odds Ratio ES:
OR [ 95 %CI] = 1.72 [ 1.03 , 2.88 ]p-value(OR) = 0.04
Log OR [ 95 %CI] = 0.54 [ 0.03 , 1.06 ]var(lOR) = 0.07
p-value(Log OR) = 0.04
Other:>>

NNT = 10.62
Total N = 197> # effectsizeパッケージのcohens_dまたはhedges_g関数を使う方法> library(effectsize)> cohens_d(不安~説明, data=d1)
Cohen's d |95% CI-----------------------0.30| [0.02, 0.58]- Estimated using pooled SD.>> cohens_d(不安~説明, data=d1, pooled_sd=FALSE)
Cohen's d |95% CI-----------------------0.30| [0.02, 0.58]- Estimated using un-pooled SD.>> hedges_g(不安~説明, data=d1)
Hedges' g |95% CI-----------------------0.30| [0.02, 0.58]- Estimated using pooled SD.>> hedges_g(不安~説明, data=d1, pooled_sd=FALSE)
Hedges' g |95% CI-----------------------0.30| [0.02, 0.58]- Estimated using un-pooled SD.>174

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

平均値の非劣性・同等性の検証 ― 素データ
t.test(実験群データ, 参照群データ, paired=FALSE, conf.level=0.95)
t.test(実験群データ, 参照群データ, paired=FALSE, conf.level=0.90)
conf.level のデフォルトは0.95なので，95%CIのときは省略してもよい．
平均値差の95%信頼区間，90%信頼区間 をそれぞれ推定して，大小比較する．
非劣性マージンはsd/3とするのが一般的．プールした分散を使うか，対照群のsdを使うかは場合による．

> rm(list=ls())> setwd("d:\\Rreport\\")> d1 <- read.table("平均値の非劣性データ2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 補習 成績
1
1 なし
57
2
2 なし
55
3
3 あり
49
4
4 なし
52
5
5 なし
57
6
6 あり
55
>
> # 記述統計量> library(psych)> describeBy(d1$成績, d1$補習, mat=TRUE, digits=2)
item group1 vars
n meansd median trimmed mad min max range skew kurtosis
se
X11
1
あり
1 215 60.27 9.82
60
59.96 8.9 31 88
57 0.19-0.08 0.67
X12
2
なし
1 185 58.82 9.14
58
58.81 8.9 36 83
47 0.06
0.00 0.67>> # 非劣性を確認したい群データ> d11 <- d1[d1$補習=="あり",]>> # 参照群データ> d10 <- d1[d1$補習=="なし",]>> # 平均値差> mean(d11$成績) - mean(d10$成績)[1] 1.453551>>> # 非劣性マージン： 参照群のSDの1/3> sd(d10$成績)/3[1] 3.047505> #平均値の非劣性の検証> #95%信頼区間の推定> t.test(d11$成績, d10$成績, paired=FALSE, conf.level=0.95)
Welch Two Sample t-test
data: d11$成績 and d10$成績
t = 1.5318, df = 395.52, p-value = 0.1264
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:-0.4120211 3.3191235
sample estimates:
mean of x mean of y60.26977 58.81622>
175

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #90%信頼区間の推定> t.test(d11$成績, d10$成績, paired=FALSE, conf.level=0.90)
Welch Two Sample t-test
data: d11$成績 and d10$成績
t = 1.5318, df = 395.52, p-value = 0.1264
alternative hypothesis: true difference in means is not equal to 0
90 percent confidence interval:-0.110960 3.018062
sample estimates:
mean of x mean of y60.26977 58.81622

標本平均は，実験群60.27，参照群58.82，平均値差は1.45である。
平均値差の検定のp値は0.13で統計的に有意でなく，平均値差に差があるとは言えない。
95%CIの下限（-0.41）≧ －非劣性マージン（-3.05）なので，非劣性が言える。
90%CIの下限（-0.11）＜ 0 なので，同等性は言えない。
（もし，同等性が言えたら，優越性の判断も行うこと。）
実験群の平均値は，参照群の平均値に比べ遜色ない程度（非劣性）とは言えるが，同等とは言えない。

176

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

平均値の非劣性・同等性の検証 ― 要約統計量
自作関数を使う
doutou.m.unpaired(人数0, 平均0, SD0,

人数1, 平均1, SD1)

m1 が m0 に劣らないと言えるかどうかを検討する
非劣性マージンdを指定することもできる．指定しなければ全体のSDを使う．

# --------------------------------------------------------------------------------------------doutou.m.unpaired<- function(n0, m0, s0, n1, m1, s1, d=NA){dm <- m1 - m0
n <- n0 + n1
df <- n - 2
s <- sqrt(((n0-1)*s0*s0+(n1-1)*s1*s1)/df)
se <- s * sqrt(1/n0+1/n1)
t95 <- qt(0.975, df)
t90 <- qt(0.950, df)
L95 <- dm - t95 * se
H95 <- dm + t95 * se
L90 <- dm - t90 * se
H90 <- dm + t90 * seZERO <- 0
if (is.na(d)) d <- s/3
MINUS_D <- -dif (L95 < MINUS_D) KEKKA <- "非劣性は言えない"
else if ((L95 <= ZERO) & (L90 < ZERO)) KEKKA <- "非劣性まで言える"
else if ((L95 <= ZERO) & (L90 >= ZERO)) KEKKA <- "同等以上まで言える"
else if (L95 > ZERO) KEKKA <- "優越性まで言える"
else KEKKA <- "Error"
title <- "Equality Test : equality of means"statistic.1 <- data.frame(n0, m0, s0, n1, m1, s1, m1-m0, s, d)statistic.2 <- data.frame(MINUS_D, L95, L90, ZERO, H90, H95)
out <- list(title, statistic.1, statistic.2, KEKKA)
return(out)}# --------------------------------------------------------------------------------------------->>> # 非劣性を検討する群> n1 <- 215> m1 <- 60.27> s1 <- 9.82>
> # 参照群> n0 <- 185> m0 <- 58.82> s0 <- 9.14>
> # 非劣性マージン> d <- s0/3>
> doutou.m.unpaired(n0, m0, s0, n1, m1, s1,d)[[1]][1] "Equality Test : equality of means"
[[2]]
n0
m0
s0 n1
m1
s1 m1...m0sd
1 185 58.82 9.14 215 60.27 9.82
1.45 9.511672 3.046667[[3]]
MINUS_DL95
L90 ZERO
H90
H95
1 -3.046667 -0.4252214 -0.1226102
0 3.02261 3.325221[[4]][1] "非劣性まで言える"

177

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２群の分散の比較 ― 素データ
var.test(変数1, 変数2)

または

var.test(変数 ~ 群分け変数, データフレーム名)

対応のないt検定においては，等分散性が仮定できるか否かが問題となる．等分散性の検定を行って分散が等しいという帰無仮説が保持されれば（棄却されなければ），t検定において var.equal=TRUE という指定をすることにより，検出力を高めることができる．
よくわからないときは，等分散性を仮定しない（何も指定しない）．その場合，自由度は小数点以下を切り捨てて整数にしておいたほうが無難．

> setwd("d:\\")> d1 <- read.table("対応のない2群の平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号
説明 不安
1
1 ビデオ
26
2
2 看護師
24
3
3 ビデオ
29
4
4 看護師
23
5
5 ビデオ
25
6
6 看護師
23
>
>
> # 記述統計量> library(psych)> describeBy(d1[,c("不安")], d1$説明)
group: ビデオ
vars
n meansd median trimmed mad min max range skew kurtosis
se1
1 103 27.04 4.32
27
27.12 4.45 17 37
20 -0.1-0.44 0.43--------------------------------------------------------group: 看護師
vars n mean
sd median trimmed mad min max range skew kurtosis
se1
1 94 25.44 6.22
25
25.43 5.93
9 40
31 -0.03-0.15 0.64>
> # 分散> tapply(d1[,c("不安")], d1$説明, var)ビデオ
看護師
18.62593 38.70018>> # 等分散性の検定> var.test(不安 ~ 説明, d1)
F test to compare two variances
data: 不安 by 説明
F = 0.4813, num df = 102, denom df = 93, p-value = 0.0003419
alternative hypothesis: true ratio of variances is not equal to 1
95 percent confidence interval:
0.3220954 0.7164806
sample estimates:
ratio of variances
0.4812879>>> #箱ひげ図> boxplot(不安 ~ 説明, d1, ylim=c(0,50))>

178

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２群の分散の比較 ― 要約統計量
自作関数を使う
known.var.test(人数ベクトル, 分散の値ベクトル)#------------------------------------------------known.var.test <- function(n, u){
if (u[1] < u[2]){temp <- u[1]; u[1]<- u[2]; u[2] <- temp; df1 <- n[2]-1; df2 <- n[1]-1}
else { df1 <- n[1]-1; df2 <- n[2]-1}
v <- u*u
F <- u[1]^2/u[2]^2
p.value <- round(2 *(1 - pf(F, df1, df2)),4)
title <- "Equality Test : equality of two variances"
statistic.1 <- data.frame(n, u, v)
statistic.2 <- data.frame(F, df1, df2, p.value)out <- list(title, statistic.1, statistic.2)
return(out)}# ------------------------------------------------------>> #各群の人数> n <- c(103, 94)>> #各群の標準偏差（不偏分散の平方根）> u <- c(4.32, 6.22)>> known.var.test(n, u)[[1]][1] "Equality Test : equality of two variances"
[[2]]
n
u
v
1 103 6.22 38.6884
2 94 4.32 18.6624[[3]]
F df1 df2 p.value
1 2.073067 93 102
4e-04

179

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多群の分散の比較 ― 素データ
bartlett.test(変数1, 変数2)

またはbartlett.test(変数 ~ 群分け変数, データフレーム名)

分散分析においては，等分散性が仮定できるか否かが問題となることがある．等分散性の検定を行って分散が等しいという帰無仮説が保持されれば（棄却されなければ），分散分析において var.equal=TRUE という指定をすることにより，検出力を高めることができる．
よくわからないときは，等分散性を仮定しない（何も指定しない）．その場合，自由度は小数点以下を切り捨てて整数にしておいたほうが無難．

> setwd("d:\\")> d1 <- read.table("1B平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 group utsu
1
1
60
23
2
2
50
24
3
3
50
28
4
4
40
29
5
5
60
36
6
6
50
22
>
> # 記述統計量> library(psych)> describeBy(d1[,c("utsu")], d1$group)group: 40vars n mean
sd median trimmed mad min max range skew kurtosis
se1
1 73 26.56 5.71
26
26.59 5.93 14 41
27 0.08-0.38 0.67--------------------------------------------------------group: 50
vars n mean
sd median trimmed mad min max range skew kurtosis
se1
1 81 29.26 7.09
29
29.25 7.41 13 47
34 0.03-0.3 0.79--------------------------------------------------------group: 60
vars n mean
sd median trimmed mad min max range skew kurtosis
se1
1 84 27.51 6.69
27
27.43 7.41 11 44
33 0.1-0.53 0.73>
> # 分散> tapply(d1[,c("utsu")], d1$group, var)
40
50
60
32.61073 50.31944 44.80709>> #等分散性の検定> bartlett.test(utsu ~ group, d1)
Bartlett test of homogeneity of variances
data: utsu by group
Bartlett's K-squared = 3.6091, df = 2, p-value = 0.1646>> #箱ひげ図> boxplot(utsu ~ group, d1, ylim=c(0,50))
>
>
>

180

名古屋 大学
多群の分散の比較 ― 要約統計量
自作関数を使う
known.bartlett.test(人数ベクトル, 分散の値ベクトル)#------------------------------------------------known.bartlett.test <- function(n, u){v <- u*un1 <- n-1
sum.Q<- sum(n1 * v)
q <- length(n)df <- q-1
f <- sum(n)-q
X.2 <- f*log(sum.Q/f) - sum(n1 * log(v))
B <- X.2 / (1+1/3/df*(sum(1/n1)-1/f))
p.value <- round(1 - pchisq(B, df),4)
title <- "Equality Test : equality of variances"
statistic.1 <- data.frame(n, u, v)
statistic.2 <- data.frame(B, df, p.value)out <- list(title, statistic.1, statistic.2)
return(out)}# -------------------------------------------------->> #各群の人数> n <- c(73, 81, 84)>> #各群の標準偏差（不偏分散の平方根）> u <- c(5.71, 7.09, 6.69)>> known.bartlett.test(n, u)[[1]][1] "Equality Test : equality of variances"
[[2]]
n
u
v
1 73 5.71 32.6041
2 81 7.09 50.2681
3 84 6.69 44.7561[[3]]
B df p.value
1 3.594569 2 0.1657
>
>

181

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

１つの被験者間要因(１Ｂ)
独立変数の型変換
独立変数 <- as.factor(独立変数)【重要！！】
独立変数をfactor型と言われる形式にしておかなければならない関数が多いので，まずこれをやっておく．
factor型にしていないと，間違った分散分析をした結果を出力してしまう．
間違っているかどうかは，独立変数の自由度Dfの値が「水準数-1」になっているか否かなどでわかる．

1つの被験者間要因の分散分析
aovを使う方法
aov(従属変数 ~ 独立変数, データフレーム名)
anovaを使う方法
anova(lm(従属変数 ~ 独立変数, データフレーム名))
Anovaを使う方法
library(car)オブジェクト名 <- lm(従属変数 ~ 独立変数, データフレーム名)
Anova(オブジェクト名)oneway.testを使う方法（等分散性を仮定する）
oneway.test(従属変数 ~ 独立変数, データフレーム名, var.equal=TRUE)
oneway.testを使う方法（等分散性を仮定しない）
oneway.test(従属変数 ~ 独立変数, データフレーム名)
上記のうち，Anova, aov, anova(lm()) は等分散性を仮定して分析する．oneway.testは等分散性を仮定することも，仮定しないことも指定できる．

多重比較
テューキー法TukeyHSD(aov(従属変数 ~ 独立変数, データフレーム名))またはTukeyHSD(aovの出力結果)
シェッフェ方法
library(agricolae)
scheffe.test(aov(従属変数 ~ 独立変数, データフレーム名), "要因名")
またはscheffe.test(aovかlmの出力結果, "要因名")
あらかじめagricolaeパッケージをインストールしておく必要がある．
group=FALSE を指定すると，対比較の検定をする．
ボンフェロニ法
pairwise.t.test(従属変数, 独立変数, p.adjust.method="bonferroni")p.adjusted.method: “holm”,“hochberg”,“hommel”,“bonferroni”,“BH”,“BY”,“fdr”

効果量
各効果について，η2乗，偏η2乗，ω2乗の全部または一部を計算する。
effectsizeパッケージのeta_squared, omega_squared関数を使う方法
library(effectisize)
eta_squared(分散分析結果オブジェクト, alternative="two.sided")omega_squared(分散分析結果オブジェクト, alternative="two.sided")
あらかじめeffectsizeパッケージをインストールしておく必要がある．
分散分析を実行した結果オブジェクトをeta_squared, omega_squaredに入れる．
aov, anova, Anova, oneway.test関数で分散分析を実行した結果オブジェクトをeta_sauared, omega_squa
redに入れる。
効果量の信頼区間の推定する際，alternative="two.sided" を指定しておくと，下限と上限を推定する信頼区間となる。（指定しない場合，上限は1.00となる。）
182名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

DescToolsパッケージのEtaSq関数を使う方法
library(DescTools)
EtaSq(aovオブジェクト)
あらかじめDescToolsパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqに入れる．
typeオプションで平方和のタイプを選択できる．デフォルトはタイプ2．
lsrパッケージのetaSquared関数を使う方法
library(lsr)
etaSquared(aovオブジェクト)
あらかじめlsrパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqqaredに入れる．
typeオプションで平方和のタイプを選択できる．デフォルトはタイプ2．

> setwd("i:\\Rdocuments\\scripts")> d1 <- read.table("1B平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 group utsu
1
1
60
23
2
2
50
24
3
3
50
28
4
4
40
29
5
5
60
36
6
6
50
22
>
> # 各群の記述統計量> library(psych)> describeBy(d1$utsu, d1$group, mat=TRUE, digits=2)
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
40
1 73 26.56 5.71
26
26.59 5.93 14 41
27 0.08-0.38 0.67
X12
250
1 81 29.26 7.09
29
29.25 7.41 13 47
34 0.03-0.30 0.79
X13
360
1 84 27.51 6.69
27
27.43 7.41 11 44
33 0.10-0.53 0.73>>
> # 全体の記述統計量> describe(d1$utsu)
vars
n meansd median trimmed mad min max range skew kurtosisse1
1 238 27.82 6.62
27
27.74 7.41 11 47
36 0.14-0.27 0.43>

> # まとめて出力> dtmp <- NULL
> dtmp$x <- d1$utsu> dtmp$group <- d1$group>> dtmp <- data.frame(dtmp)> ntmp <- as.matrix(table(dtmp$group))> mtmp <- tapply(dtmp$x, dtmp$group, mean)> stmp <- tapply(dtmp$x, dtmp$group, sd)> itmp <- tapply(dtmp$x, dtmp$group, min)> etmp <- tapply(dtmp$x, dtmp$group, median)> atmp <- tapply(dtmp$x, dtmp$group, max)
> nta <- nrow(dtmp)> mta <- mean(dtmp$x)> sta <- sd(dtmp$x)> ita <- min(dtmp$x)> eta <- median(dtmp$x)
183

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> ata <- max(dtmp$x)> otmp <- round(data.frame(ntmp, mtmp, stmp, itmp, etmp, atmp),2)> ota <- round(data.frame(nta, mta, sta, ita, eta, ata),2)> rownames(ota) <- "Total"> colnames(otmp) <- colnames(ota) <- c("N","Mean", "SD","Min","Median", "Max")> otmp <- rbind(otmp, ota)
> otmpN MeanSD Min Median Max
40
73 26.56 5.71 14
26 41
50
81 29.26 7.09 13
29 47
60
84 27.51 6.69 11
27 44
Total 238 27.82 6.62 11
27 47>> #分散分析> #aovを使う方法> d1$group <- as.factor(d1$group)> result.aov <- aov(utsu ~ group, data=d1)> summary(result.aov)
Df Sum Sq Mean Sq F value Pr(>F)
group2
291 145.67
3.392 0.0353 *Residuals
235 10093
42.95--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> #anovaを使う方法> d1$group <- as.factor(d1$group)> mod.1 <- lm(utsu ~ group, data=d1)> (result.anova <- anova(mod.1))
Analysis of Variance Table
Response: utsu
Df Sum Sq Mean Sq F value Pr(>F)
group2
291.3 145.675
3.392 0.0353 *Residuals 235 10092.5 42.947--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> #Anovaを使う方法> library(car)> d1$group <- as.factor(d1$group)> mod.1 <- lm(utsu~group,data=d1)> (result.Anova <- Anova(mod.1))
Anova Table (Type II tests)
Response: utsu
Sum Sq Df F value Pr(>F)
group
291.3
2
3.392 0.0353 *Residuals 10092.5 235--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> #oneway.testを使う方法（等分散性を仮定する）> d1$group <- as.factor(d1$group)> result.oneway.equal <- oneway.test(utsu ~ group, data=d1, var.equal=TRUE)> result.oneway.equal184名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

One-way analysis of means
data: utsu and group
F = 3.392, num df = 2, denom df = 235, p-value = 0.0353>> #oneway.testを使う方法（等分散性を仮定しない）> d1$group <- as.factor(d1$group)> (result.oneway <- oneway.test(utsu ~ group, data=d1))
One-way analysis of means (not assuming equal variances)
data: utsu and group
F = 3.4125, num df = 2.000, denom df = 156.372, p-value = 0.03543> #多重比較> #テューキーの方法> (mc.tukey <- TukeyHSD(result.aov))Tukey multiple comparisons of means
95% family-wise confidence level
Fit: aov(formula = utsu ~ group, data = d1)$group
diff
lwr
upr
p adj
50-40 2.6976154 0.2030911 5.1921398 0.0304917
60-40 0.9502609 -1.5230578 3.4235796 0.6369201
60-50 -1.7473545 -4.1544379 0.6597289 0.2027422> #シェッフェの方法> library(agricolae)> # group=FALSE を指定したシェッフェの方法> (mc.scheffe <- scheffe.test(result.aov, "group", group=FALSE))$statistics
MSerror Df
F
Mean
CV
42.94688 235 3.034248 27.81513 23.56051$parameters
test name.t ntr alphaScheffe group
3 0.05$meansutsu
std r Min Max Q25 Q50 Q75
40 26.56164 5.710581 73 14 41 23 26 31
50 29.25926 7.093620 81 13 47 24 29 34
60 27.51190 6.693809 84 11 44 22 27 32$comparison
Difference pvalue sig
LCL
UCL
40 - 50 -2.6976154 0.0404* -5.3029455 -0.09228539
40 - 60 -0.9502609 0.6637-3.5334434 1.63292150
50 - 60 1.7473545 0.2330-0.7666505 4.26135954$groupsNULL
attr(,"class")[1] "group"185名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # group=TRUE を指定したシェッフェの方法> (mc.scheffe <- scheffe.test(result.aov, "group", group=TRUE))$statistics
MSerror Df
F
Mean
CV
42.94688 235 3.034248 27.81513 23.56051$parameters
test name.t ntr alphaScheffe group
3 0.05$meansutsu
std r Min Max Q25 Q50 Q75
40 26.56164 5.710581 73 14 41 23 26 31
50 29.25926 7.093620 81 13 47 24 29 34
60 27.51190 6.693809 84 11 44 22 27 32$comparison
NULL$groups
utsu groups
50 29.25926
a
60 27.51190
ab
40 26.56164b
attr(,"class")[1] "group"> #ボンフェロニの方法> (mc.bon <- pairwise.t.test(d1$utsu, d1$group, p.adjust.method="bonferroni"))
Pairwise comparisons using t tests with pooled SD
data:

d1$utsu and d1$group40
50
50 0.034 60 1.000 0.265
P value adjustment method: bonferroni>>> #平均値を比較する棒グラフの作成> barplot(mtemp, ylim=c(0,35), ylab="Mean", space=1)> segments(0,0, 7,0)>186

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #効果量> # eta_squared関数，omega_squared関数を使う方法> library(effectsize)> eta_squared(result.aov, alternative="two.sided")
For one-way between subjects designs, partial eta squared is equivalent to eta squared. Returningeta
squared.
# Effect Size for ANOVAParameter | Eta2 |95% CI------------------------------group| 0.03 | [0.00, 0.08]> eta_squared(result.anova, alternative="two.sided")
For one-way between subjects designs, partial eta squared is equivalent to eta squared. Returningeta
squared.
# Effect Size for ANOVAParameter | Eta2 |95% CI------------------------------group| 0.03 | [0.00, 0.08]> eta_squared(result.Anova, alternative="two.sided")
For one-way between subjects designs, partial eta squared is equivalent to eta squared. Returningeta
squared.
# Effect Size for ANOVAParameter | Eta2 |95% CI------------------------------group| 0.03 | [0.00, 0.08]> eta_squared(result.oneway.equal, alternative="two.sided")
For one-way between subjects designs, partial eta squared is equivalent to eta squared. Returningeta
squared.
# Effect Size for ANOVA
Eta2 |
95% CI------------------0.03 | [0.00, 0.08]> eta_squared(result.oneway, alternative="two.sided")
For one-way between subjects designs, partial eta squared is equivalent to eta squared. Returningeta
squared.
# Effect Size for ANOVA
Eta2 |
95% CI------------------0.04 | [0.00, 0.11]
警告メッセージ:`var.equal = FALSE` - effect size is an approximation.

187名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> omega_squared(result.aov, alternative="two.sided")
For one-way between subjects designs, partial omega squared is equivalent to omega squared. Returningomega squared.
# Effect Size for ANOVAParameter | Omega2 |95% CI--------------------------------group|0.02 | [0.00, 0.06]> omega_squared(result.anova, alternative="two.sided")
For one-way between subjects designs, partial omega squared is equivalent to omega squared. Returningomega squared.
# Effect Size for ANOVAParameter | Omega2 |95% CI--------------------------------group|0.02 | [0.00, 0.06]> omega_squared(result.Anova, alternative="two.sided")
For one-way between subjects designs, partial omega squared is equivalent to omega squared. Returningomega squared.
# Effect Size for ANOVAParameter | Omega2 |95% CI--------------------------------group|0.02 | [0.00, 0.06]> omega_squared(result.oneway.equal, alternative="two.sided")
For one-way between subjects designs, partial omega squared is equivalent to omega squared. Returningomega squared.
# Effect Size for ANOVA
Omega2 |95% CI--------------------0.02| [0.00, 0.06]> omega_squared(result.oneway, alternative="two.sided")
For one-way between subjects designs, partial omega squared is equivalent to omega squared. Returningomega squared.
# Effect Size for ANOVA
Omega2 |95% CI--------------------0.03| [0.00, 0.09]
警告メッセージ:`var.equal = FALSE` - effect size is an approximation.

> #EtaSq関数を使う方法> library(DescTools)> EtaSq(result.aov)eta.sq eta.sq.part
group 0.02805788 0.02805788> #EtaSquared関数を使う方法> library(lsr)> etaSquared(result.aov)eta.sq eta.sq.part
group 0.02805788 0.02805788
188

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

１つの被験者内要因(１Ｗ)
aovを使う方法
まずstackデータを作成
d3 <- stack(被験者内要因の各水準を列とするデータだけのデータフレーム名)
d4 <- data.frame(d3, 被験者IDの変数名)
colnames(d4) <- c("y", "x", "id")d4$x <- as.factor(d4$x)
d4$id <- as.factor(d4$id)aov(y ~ x + id, data=d4)「球面性の仮定」が満たされることを前提としている．
【重要！！】
独立変数をfactor型と言われる形式にしておかなければならない関数が多いので，まずこれをやっておく．
factor型にしていないと，間違った分散分析をした結果を出力してしまう．
間違っているかどうかは，「独立変数の自由度Dfの値が“水準数-1”になっているか否か」などでわかる．

Anovaを使う方法
library(car)
被験者内要因名 <- factor(c("条件1","条件2","条件3",…))
全被験者内要因 <- data.frame(被験者内要因名)
lmオブジェクト名 <- lm(cbind(条件1の従属変数,条件2の従属変数,…)~1, データフレーム名)
Anovaオブジェクト名 <- Anova(lmオブジェクト名, idata=全被験者内要因, idesign=~被験者内要因名)
summary(Anovaオブジェクト名, multivariate=FALSE)「球面性の仮定」の検討をして，修正した結果も表示する．
あらかじめcarパッケージをインストールしておく必要がある．
被験者内要因名をfactor型にしておく．
被験者間要因はないので，線形モデル（lm）の独立変数（~の右側）は固定値 1 にしておく．
summary で multivariate=TRUE としておくと，多変量分散分析の結果も表示してくれる．

多重比較
ボンフェロニ法
pairwise.t.test(従属変数, 独立変数, p.adjust.method="bonferroni", paired=TRUE)
p.adjusted.method: “holm”,“hochberg”,“hommel”,“bonferroni”,“BH”,“BY”,“fdr”の値を変えれば，他の方法での多重比較も行える

効果量
各効果について，η2乗，偏η2乗，ω2乗の全部または一部を計算する。
effectsizeパッケージのeta_squared, omega_squared関数を使う方法
library(effectisize)
eta_squared(分散分析オブジェクト, alternative="two.sided")omega_squared(分散分析オブジェクト, alternative="two.sided")
あらかじめsjstatsパッケージをインストールしておく必要がある．
aov, Anovak関数で分散分析を実行した結果オブジェクトをeta_squaed, omega_squaredに入れる．
効果量の信頼区間の推定する際，alternative="two.sided" を指定しておくと，下限と上限を推定する信頼区間となる。（指定しない場合，上限は1.00となる。）
DescToolsパッケージのEtaSq関数を使う方法
library(DescTools)
EtaSq(aovオブジェクト)
あらかじめDescToolsパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqに入れる．
typeオプションで平方和のタイプを選択できる．デフォルトはタイプ2．

189名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

lsrパッケージのetaSquared関数を使う方法
library(lsr)
etaSquared(aovオブジェクト)
あらかじめlsrパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqqaredに入れる．
typeオプションで平方和のタイプを選択できる．デフォルトはタイプ2．

> setwd("d:\\")> d1 <- read.table("1W平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)Team Rank Cooperate
1
13
15
14
2
15
15
10
3
11
13
13
4
14
14
18
5
15
10
14
6
11
11
14
>
>
>
> # 各群の人数・平均値・標準偏差> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD Team Rank CooperateTeam
164 12.42 1.63 1.00 0.21
0.20
Rank
164 12.12 1.57 0.21 1.00
0.21
Cooperate 164 13.30 1.63 0.20 0.21
1.00>
> #stackデータの作成> d3 <- stack(dtmp)> did <- c(1:nrow(dtmp))> d4 <- data.frame(d3, did)> colnames(d4) <- c("y", "x", "id")> d4$x <- as.factor(d4$x)> d4$id <- as.factor(d4$id)> head(d4)yx id
1 13 Team 1
2 15 Team 2
3 11 Team 3
4 14 Team 4
5 15 Team 5
6 11 Team 6>>> #分散分析> #aovを使う方法> result.aov <- aov(y ~ x + id, data=d4)> summary(result.aov)
Df Sum Sq Mean Sq F value
Pr(>F)
x
2 124.1
62.05 30.229 9.05e-13 ***id
163 595.1
3.65
1.778 6.35e-06 ***Residuals
326 669.2
2.05--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>
190

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # Anovaを使う方法> library(car)> fac.a <- factor(c("Team", "Rank", "Cooperate"))> youin <- data.frame(fac.a)> mod.1 <- lm(cbind(Team, Rank, Cooperate)~1,d1)> result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.a)
Note: model has only an intercept; equivalent type-III tests substituted.
> summary(result.Anova, multivariate=FALSE)
Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
SS num Df Error SS den Df
F
Pr(>F)(Intercept) 78307
1595.06163 21449.790 < 2.2e-16 ***
fac.a
124
2
669.22326
30.229 9.054e-13 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Mauchly Tests for Sphericity
fac.a

Test statistic p-value
0.99895 0.91826

Greenhouse-Geisser and Huynh-Feldt Corrections
for Departure from Sphericity
GG eps Pr(>F[GG])fac.a 0.99895 9.284e-13 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
HF epsPr(>F[HF])
fac.a 1.011338 9.053813e-13
警告メッセージ:
In summary.Anova.mlm(result.Anova, multivariate = FALSE) :HF eps > 1 treated as 1>>

> # 多重比較> pairwise.t.test(d4$y, d4$x, p.adjust.method="bonferroni", paired=TRUE)
Pairwise comparisons using paired t tests
data:

d4$y and d4$x

Team
Rank
Rank
0.17
Cooperate 4.3e-07 1.0e-11
P value adjustment method: bonferroni >> #平均値を比較するグラフ> barplot(colMeans(dtmp), ylim=c(0, 16), ylab="Mean", space=1)> segments(0,0, 7,0)
>
>

191

名古屋 大学> # 効果量> #eta_squared,omega_sqared関数を使う方法> library(effectsize)> eta_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter | Eta2 (partial) |95% CI----------------------------------------x|
0.16 | [0.09, 0.23]
id|
0.47 | [0.16, 0.54]> omega_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter | Omega2 (partial) |95% CI------------------------------------------x|
0.11 | [0.05, 0.17]
id|
0.21 | [0.00, 0.00]>> eta_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type III)
Parameter | Eta2 (partial) |95% CI----------------------------------------fac.a|
0.16 | [0.09, 0.23]> omega_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type III)
Parameter | Omega2 (partial) |95% CI------------------------------------------fac.a|
0.09 | [0.03, 0.15]> #EtaSq関数を使う方法> library(DescTools)> EtaSq(result.aov)eta.sq eta.sq.part
x 0.08939073
0.1564409
id 0.42859736
0.4706710>> #lsr関数を使う方法> library(lsr)> etaSquared(result.aov)eta.sq eta.sq.part
x 0.08939073
0.1564409
id 0.42859736
0.4706710

192

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２つの被験者間要因(２Ｂ)
データフレーム名：d1
被験者ID：
id
被験者間要因1：
x1
被験者間要因2：x2
従属変数：
y
独立変数の型変換
d1$x1 <- as.factor(d1$x1)
d1$x2 <- as.factor(d1$x2)【重要！！】
独立変数をfactor型と言われる形式にしておかなければならない関数が多いので，まずこれをやっておく．
factor型にしていないと，間違った分散分析をした結果を出力してしまう．
間違っているかどうかは，独立変数の自由度Dfの値が「水準数-1」になっているか否かなどでわかる．
aovを使う方法
lmオブジェクト名 <- lm(y ~ x1 * x2, data=d1)
aovオブジェクト名 <- aov(lmオブジェクト名)summary(aovオブジェクト名)
anovaを使う方法
lmオブジェクト名 <- lm(y ~ x1 * x2, data=d1)
anovaオブジェクト名 <- anova(lmオブジェクト名)
anovaオブジェクト名
Anovaを使う方法
library(car)lmオブジェクト名 <- lm(y~x1 * x2, d1)
Anova オブジェクト名 <- Anova(lmオブジェクト名)
Anova オブジェクト名
あらかじめcarパッケージをインストールしておく必要がある．
被験者間要因が2つあるので，線形モデル(lm)の独立変数を「独立変数1 * 独立変数2」とする．

多重比較 テューキー法
TukeyHSD(aov(y ~ x1 * x2, d1) またはTukeyHSD(aovの出力結果)

効果量
各効果について，η2乗，偏η2乗，ω2乗の全部または一部を計算する。
effectsizeパッケージのeta_squared, omega_squared関数を使う方法
library(effectsize)
eta_squared(分散分析オブジェクト, alternative="two.sided")omega_squared(分散分析オブジェクト, alternative="two.sided")
あらかじめeffectsizeパッケージをインストールしておく必要がある．
aov, anova, Anova関数で分散分析を実行した結果オブジェクトをeta_squared, omega_squaredに入れる．
効果量の信頼区間の推定する際，alternative="two.sided" を指定しておくと，下限と上限を推定する信頼区間となる。（指定しない場合，上限は1.00となる。）
DescToolsパッケージのEtaSq関数を使う方法
library(DescTools)
EtaSq(aovオブジェクト)
あらかじめDescToolsパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqに入れる．
typeオプションで平方和のタイプを選択できる．デフォルトはタイプ2．

193

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

lsrパッケージのetaSquared関数を使う方法
library(lsr)
etaSquared(aovオブジェクト)
あらかじめlsrパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqqaredに入れる．
typeオプションで平方和のタイプを選択できる．デフォルトはタイプ2．

単純効果の検定
library(phia)
testInteractions(lmオブジェクト名, fixed="変数名１", across="変数名2")
またはtestInteractions(lmオブジェクト名, fixed="変数名１", pairwise="変数名2")
あらかじめphiaパッケージをインストールしておく必要がある．
fixedで指定した変数の水準ごとに，acrossで指定した変数の単純主効果の検定，pairwiseで指定した変数の任意の2水準間の効果の検定を行う．
調整済み平均値の推定と作図(オブジェクト名 <- interactionMeans(lmオブジェクト名))
plot(オブジェクト名)
一方の変数の各水準における，他方の変数の平均値を比較した折れ線グラフを作図する> setwd("i:\\Rdocuments\\scripts")> d1 <- read.table("2B平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id work
future tekiou
1 1 few shingaku
17
2 2 few shingaku
13
3 3 few shingaku
12
4 4 few shingaku
14
5 5 few shushoku
10
6 6 few shushoku
12>>> # 独立変数をfactor型に変換> d1$work <- factor(d1$work, levels=c("many","few"), labels=c("Many", "Few"))> d1$future <- factor(d1$future, levels=c("shingaku","shushoku","mitei"),+labels=c("Shingaku", "Shushoku","Mitei"))> head(d1)
id work
future tekiou
1 1 Few Shingaku
17
2 2 Few Shingaku
13
3 3 Few Shingaku
12
4 4 Few Shingaku
14
5 5 Few Shushoku
10
6 6 Few Shushoku
12>> # 基本統計量（psychパッケージのdescribeBy関数を使う方法）> library(psych)>194名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # セル単位> (stats_c <- describeBy(d1$tekiou, list(d1$work, d1$future), mat=TRUE, digits=2))
item group1
group2 vars n mean
sd median trimmed mad min max range skew kurtosisse
X11
1
Many Shingaku
1 24 14.38 1.61
14.0
14.30 1.48 12 18
6 0.43-0.57 0.33
X12
2
Few Shingaku
1 16 14.19 2.48
14.5
14.29 2.22
9 18
9 -0.42-0.84 0.62
X13
3
Many Shushoku
1 64 12.84 1.77
13.0
12.79 1.48
9 17
8 0.28-0.22 0.22
X14
4
Few Shushoku
1 80 12.29 2.06
12.0
12.12 1.48
9 19
10 0.65
0.21 0.23
X15
5
Many
Mitei
1 24 10.38 2.00
10.5
10.40 2.22
6 14
8 -0.15-0.41 0.41
X16
6
Few
Mitei
1 18 12.00 1.78
12.0
12.00 1.48
9 15
6 0.06-0.92 0.42>
> # 変数単位> describeBy(d1$tekiou, list(d1$work), mat=TRUE, digits=2)
item group1 vars
n meansd median trimmed mad min max range skew kurtosis
se
X11
1
Many
1 112 12.64 2.22
13
12.67 1.48
6 18
12 -0.19
0.16 0.21
X122Few
1 114 12.51 2.18
12
12.38 2.22
9 19
10 0.50-0.23 0.20>
> describeBy(d1$tekiou, list(d1$future), mat=TRUE, digits=2)
itemgroup1 vars
n meansd median trimmed mad min max range skew kurtosisseX11
1 Shingaku
1 40 14.30 1.98
14
14.34 1.48
9 18
9 -0.25-0.09 0.31
X12
2 Shushoku
1 144 12.53 1.95
12
12.43 1.48
9 19
10 0.46
0.02 0.16
X13
3
Mitei
1 42 11.07 2.05
11
11.12 1.48
6 15
9 -0.16-0.28 0.32>
> # 全体> describe(d1$tekiou)
vars
n meansd median trimmed mad min max range skew kurtosisseX1
1 226 12.58 2.19
12
12.52 2.97
6 19
13 0.15-0.05 0.15

> #分散分析> # aovを使う方法> mod.1 <- lm(tekiou~work*future, data=d1)> result.aov <- aov(mod.1)> summary(result.aov)
Df Sum Sq Mean Sq F value
Pr(>F)
work
1
1.0
1.02
0.269 0.60448
future2 213.6 106.81 28.294 1.16e-11 ***work:future
2
38.1
19.04
5.043 0.00722 **Residuals
220 830.5
3.78--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1>>> # anovaを使う方法> mod.1 <- lm(tekiou~work*future, data=d1)> result.anova <- anova(mod.1)> result.anova
Analysis of Variance Table
Response: tekiou
Df Sum Sq Mean Sq F value
Pr(>F)
work
1
1.02
1.016 0.2691 0.604483
future2 213.62 106.810 28.2936 1.161e-11 ***work:future
2 38.07 19.036 5.0427 0.007223 **Residuals
220 830.51
3.775--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1>>> # Anovaを使う方法> library(car)> mod.1 <- lm(tekiou~work*future, data=d1)> result.Anova <- Anova(mod.1)> result.Anova
Anova Table (Type II tests)
195名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Response: tekiou
Sum Sq Df F value
Pr(>F)
work
0.43
1 0.1130 0.737057
future213.62
2 28.2936 1.161e-11 ***work:future 38.07
2 5.0427 0.007223 **Residuals
830.51 220--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1>> #多重比較> #テューキーの方法> (mc.tukey <- TukeyHSD(result.aov)))
Tukey multiple comparisons of means
95% family-wise confidence level
Fit: aov(formula = mod.1)
$work

diff
lwr
upr
p adj
Few-Many -0.1340852 -0.6435314 0.375361 0.6044829$future
diff
lwr
upr
p adj
Shushoku-Shingaku -1.74442 -2.563854 -0.9249864 3.10e-06
Mitei-Shingaku-3.22474 -4.237645 -2.2118362 0.00e+00
Mitei-Shushoku-1.48032 -2.284340 -0.6763006 6.31e-05$`work:future`
diff
lwr
upr
p adj
Few:Shingaku-Many:Shingaku -0.18750 -1.9903740 1.6153740 0.9996764
Many:Shushoku-Many:Shingaku -1.53125 -2.8682971 -0.1942029 0.0145212
Few:Shushoku-Many:Shingaku -2.08750 -3.3875709 -0.7874291 0.0000963
Many:Mitei-Many:Shingaku-4.00000 -5.6125395 -2.3874605 0.0000000
Few:Mitei-Many:Shingaku-2.37500 -4.1167417 -0.6332583 0.0016313
Many:Shushoku-Few:Shingaku -1.34375 -2.9050847 0.2175847 0.1363042
Few:Shushoku-Few:Shingaku-1.90000 -3.4297893 -0.3702107 0.0057706
Many:Mitei-Few:Shingaku-3.81250 -5.6153740 -2.0096260 0.0000001
Few:Mitei-Few:Shingaku-2.18750 -4.1068059 -0.2681941 0.0152697
Few:Shushoku-Many:Shushoku -0.55625 -1.4930508 0.3805508 0.5285578
Many:Mitei-Many:Shushoku-2.46875 -3.8057971 -1.1317029 0.0000040
Few:Mitei-Many:Shushoku-0.84375 -2.3340773 0.6465773 0.5811320
Many:Mitei-Few:Shushoku-1.91250 -3.2125709 -0.6124291 0.0004879
Few:Mitei-Few:Shushoku-0.28750 -1.7447457 1.1697457 0.9930198
Few:Mitei-Many:Mitei
1.62500 -0.1167417 3.3667417 0.0829213> #シェッフェの方法> library(agricolae)> (mc.scheffe <- scheffe.test(result.aov, "work"))$statistics
MSerror Df
F
Mean
CV
3.775057 220 3.884075 12.57522 15.45063$parameters
test name.t ntr alphaScheffework
2 0.05$meanstekioustd
r Min Max Q25 Q50 Q75
Few 12.50877 2.178924 114
9 19 11 12 14
Many 12.64286 2.217283 112
6 18 11 13 14
196

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部$comparison
Difference pvalue sig
LCL
UCL
Few - Many -0.1340852 0.6045-0.6435314 0.375361$groupsNULL
attr(,"class")[1] "group"> (mc.scheffe <- scheffe.test(result.aov, "future"))$statistics
MSerror Df
F
Mean
CV
3.775057 220 3.036898 12.57522 15.45063$parameters
test name.t ntr alphaScheffe future
3 0.05$meanstekioustd
r Min Max Q25 Q50
Q75
Mitei
11.07143 2.052873 42
6 15 10 11 12.00
Shingaku 14.30000 1.976788 40
9 18 13 14 15.25
Shushoku 12.53472 1.950124 144
9 19 11 12 14.00$comparison
Mitei - Shingaku
Mitei - Shushoku
Shingaku - Shushoku

Difference pvalue sig
LCL
UCL-3.228571 0e+00 *** -4.2864702 -2.1706726-1.463294 1e-04 *** -2.3030290 -0.6235583
1.765278 0e+00 *** 0.9094438 2.6211117$groupsNULL
attr(,"class")[1] "group"> # group=FALSE を指定したシェッフェの方法> (mc.scheffe <- scheffe.test(result.aov, "work", group=FALSE))$statistics
MSerror Df
F
Mean
CV
3.775057 220 3.884075 12.57522 15.45063$parameters
test name.t ntr alphaScheffework
2 0.05$meanstekioustd
r Min Max Q25 Q50 Q75
Few 12.50877 2.178924 114
9 19 11 12 14
Many 12.64286 2.217283 112
6 18 11 13 14$comparison
Difference pvalue sig
LCL
UCL
Few - Many -0.1340852 0.6045-0.6435314 0.375361$groupsNULL
attr(,"class")[1] "group"197名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> (mc.scheffe <- scheffe.test(result.aov, "future", group=FALSE))$statistics
MSerror Df
F
Mean
CV
3.775057 220 3.036898 12.57522 15.45063$parameters
test name.t ntr alphaScheffe future
3 0.05$meanstekioustd
r Min Max Q25 Q50
Q75
Mitei
11.07143 2.052873 42
6 15 10 11 12.00
Shingaku 14.30000 1.976788 40
9 18 13 14 15.25
Shushoku 12.53472 1.950124 144
9 19 11 12 14.00$comparison
Mitei - Shingaku
Mitei - Shushoku
Shingaku - Shushoku

Difference pvalue sig
LCL
UCL-3.228571 0e+00 *** -4.2864702 -2.1706726-1.463294 1e-04 *** -2.3030290 -0.6235583
1.765278 0e+00 *** 0.9094438 2.6211117$groupsNULL
attr(,"class")[1] "group"> #ボンフェロニの方法> (mc.bon.tekiou <- pairwise.t.test(d1$tekiou, d1$work, p.adjust.method="bonferroni"))
Pairwise comparisons using t tests with pooled SD
data:

d1$tekiou and d1$work

Many
Few 0.65
P value adjustment method: bonferroni> (mc.bon.gakunen <- pairwise.t.test(d1$tekiou, d1$future, p.adjust.method="bonferroni"))
Pairwise comparisons using t tests with pooled SD
data:

d1$tekiou and d1$future

Shingaku Shushoku
Shushoku 3.4e-06 Mitei
8.1e-12 1e-04
P value adjustment method: bonferroni> #平均値を比較する棒グラフの作成> m1t <- tapply(d1[,"tekiou"], list(d1[,"work"], d1[,"future"]), mean)> barplot(m1t, beside=TRUE,legend=TRUE, ylim=c(0,20), las=1, ylab="Mean")198

名古屋 大学> # 効果量> #eta_squared,omega_squared関数を使う方法> library(effectsize)> eta_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter| Eta2 (partial) |95% CI------------------------------------------work|
1.22e-03 | [0.00, 0.03]
future|0.20 | [0.12, 0.29]
work:future |0.04 | [0.00, 0.10]> omega_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter| Omega2 (partial) |95% CI--------------------------------------------work|
0.00 | [0.00, 0.00]
future|0.19 | [0.11, 0.28]
work:future |0.03 | [0.00, 0.09]> eta_squared(result.anova, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter| Eta2 (partial) |95% CI------------------------------------------work|
1.22e-03 | [0.00, 0.03]
future|0.20 | [0.12, 0.29]
work:future |0.04 | [0.00, 0.10]> omega_squared(result.anova, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter| Omega2 (partial) |95% CI--------------------------------------------work|
0.00 | [0.00, 0.00]
future|0.19 | [0.11, 0.28]
work:future |0.03 | [0.00, 0.09]>> eta_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter| Eta2 (partial) |95% CI------------------------------------------work|
5.13e-04 | [0.00, 0.02]
future|0.20 | [0.12, 0.29]
work:future |0.04 | [0.00, 0.10]> omega_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter| Omega2 (partial) |95% CI--------------------------------------------work|
0.00 | [0.00, 0.00]
future|0.19 | [0.11, 0.28]
work:future |0.03 | [0.00, 0.09]
>
>

199

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #EtaSq関数を使う方法> library(DescTools)> EtaSq(result.aov)eta.sq eta.sq.part
work
0.0003938638 0.0005134451
future0.1972081460 0.2045909323
work:future 0.0351479090 0.0438332936> #etaSquared関数を使う方法> library(lsr)> etaSquared(result.aov)eta.sq eta.sq.part
work
0.0003938638 0.0005134451
future0.1972081460 0.2045909323
work:future 0.0351479090 0.0438332936>> # 単純効果> library(phia)>> # workの各水準におけるfutureの主効果> testInteractions(mod.1, fixed="work", across="future")
F Test:P-value adjustment method: holm
future1 future2 Df Sum of Sq
F
Pr(>F)
Many
4.0000 2.4688
2
198.03 26.228 1.216e-10 ***Few
2.1875 0.2875
2
53.67 7.108
0.00102 **Residuals
220
830.51--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1>> # workの各水準におけるfuture2水準間の効果> testInteractions(mod.1, fixed="work", pairwise="future")
F Test:P-value adjustment method: holm
Value Df Sum of Sq
F
Pr(>F)
Shingaku-Shushoku : Many 1.5313
1
40.93 10.8412 0.003469 **Shingaku-Mitei : Many 4.0000
1
192.00 50.8602 8.473e-11 ***Shushoku-Mitei : Many 2.4687
1
106.38 28.1799 1.348e-06 ***Shingaku-Shushoku : Few 1.9000
1
48.13 12.7504 0.001748 **Shingaku-Mitei : Few 2.1875
140.53 10.7371 0.003469 **Shushoku-Mitei : Few 0.2875
1
1.21 0.3217 0.571149
Residuals
220
830.51--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1>> # futureの各水準におけるworkの主効果> testInteractions(mod.1, fixed="future", across="work")
F Test:P-value adjustment method: holm
Value Df Sum of Sq
F Pr(>F)
Shingaku
0.1875010.34 0.0894 0.7652
Shushoku
0.556251
11.00 2.9142 0.1784
Mitei -1.62500
127.16 7.1948 0.0236 *Residuals
220
830.51--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1>

200

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # futureの各水準におけるwork2水準間の効果> testInteractions(mod.1, fixed="future", pairwise="work")
F Test:P-value adjustment method: holm
Value Df Sum of Sq
F Pr(>F)
Many-Few : Shingaku 0.18750
10.34 0.0894 0.7652
Many-Few : Shushoku 0.55625
1
11.00 2.9142 0.1784
Many-Few :Mitei -1.62500
127.16 7.1948 0.0236 *Residuals
220
830.51--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1>>> # モデルによって調整された各セルの平均値とその概観> (mn.d1adj <- interactionMeans(mod.1))
work
future adjusted mean std. error
1 Many Shingaku
14.37500 0.3966031
2 Few Shingaku
14.18750 0.4857376
3 Many Shushoku
12.84375 0.2428688
4 Few Shushoku
12.28750 0.2172285
5 ManyMitei
10.37500 0.3966031
6 Few
Mitei
12.00000 0.4579578> plot(mn.d1adj)>

201

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

１つの被験者間要因と１つの被験者内要因(１Ｂ１Ｗ)
stackデータの作成
被験者内要因の水準ごとにstackデータを作成して，最後に縦に繋げる
vn.x <- c("mh1","mh2")
d3 <- NULL
for(i in vn.x){d2 <- d1
d2$x <- id2$y <- d1[,i]d3 <- rbind(d3,d2)}
d4<- d3[,c("id","group","x","y")]d4$id <- as.factor(d4$id)
d4$group <- as.factor(d4$group)
d4$x <- as.factor(d4$x)
head(d4)
データフレーム名：d4
被験者ID：
id
被験者間要因変数：group
被験者内要因変数：x
従属変数：y【重要！！】
被験者idも含め，独立変数をfactor型と言われる形式にしておかなければならない関数が多いので，まずこれをやっておく．
factor型にしていないと，間違った分散分析をした結果を出力してしまう．
間違っているかどうかは，独立変数の自由度Dfの値が「水準数-1」になっているか否かなどでわかる．

分散分析
aovを使う方法
result.aov <- aov(y ~ group * x + Error(id + id:group + id:group:x), data=d4)
summary(result.aov)「球面性の仮定」が満たされることを前提としている．
Anovaを使う方法
データフレーム名：d1
被験者ID
：id
被験者間要因変数：group
被験者内要因名 ：fac.b <- factor(c("b1", "b2", "b3"))
全被験者内要因 ：youin
従属変数：ylibrary(car)d1$group <- as.factor(d1$group)
fac.b <- factor(c("b1","b2","b3"))
youin <- data.frame(fac.b)mod.1 <- lm(cbind(b1, b2, b3)~group, c1)
result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.b)summary(result.Anova, multivariate=FALSE)「球面性の仮定」の検討をして，修正した結果も表示する．
あらかじめcarパッケージをインストールしておく必要がある．
multivariate=TRUE としておくと，多変量分散分析の結果も表示してくれる．
多重比較
被験者間要因pairwise.t.test(d1$y, d1$group, p.adjust.method="bonferroni")
被験者内要因pairwise.t.test(d1$y, d1$x, p.adjust.method="bonferroni", paired=TRUE)
p.adjusted.method: “holm”,“hochberg”,“hommel”,“bonferroni”,“BH”,“BY”,“fdr”
202名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

効果量
effectsizeパッケージのeta_squared, omega_squared関数を使う方法
library(effectsize)
eta_squared(分散分析オブジェクト, alternative="two.sided")omega_squared(分散分析オブジェクト, alternative="two.sided")
あらかじめeffectsizeパッケージをインストールしておく必要がある．
aov, Anova関数で分散分析を実行した結果オブジェクトをeta_squared, omega_squaredに入れる．
効果量の信頼区間の推定する際，alternative="two.sided" を指定しておくと，下限と上限を推定する信頼区間となる。（指定しない場合，上限は1.00となる。）

DescToolsパッケージのEtaSq関数を使う方法
library(DescTools)
EtaSq(aovオブジェクト, type=1)
各効果について，η2乗，偏η2乗，一般化η2乗の値を計算する．
あらかじめDescToolsパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqに入れる．
typeオプションでtype=1と指定する。（デフォルトはtype=2）> setwd("d:\\")> d1 <- read.table("1B1W平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id mh1 mh2
group
1 1 11 18 experiment
2 2 18 15 experiment
3 3 16 14
control
4 4
9 16 experiment
5 5 17 16 experiment
6 6
9 17 experiment>>> # stackデータの作成> d2 <- d1[,c("mh1","mh2")]> d3 <- stack(d2)> d4 <- data.frame(d1$id, d1$group, d3)> colnames(d4) <- c("id", "group", "y","x")> head(d4)idgroup yx
1 1 experiment 11 mh1
2 2 experiment 18 mh1
3 3
control 16 mh1
4 4 experiment 9 mh1
5 5 experiment 17 mh1
6 6 experiment 9 mh1>>> # 独立変数をfactor型に変換> d4$id <- factor(d4$id)> d4$group <- factor(d4$group)> d4$x <- factor(d4$x)>> # 基本統計量> library(psych)203名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> # セル単位> describeBy(d4$y, list(d4$x, d4$group), mat=TRUE, digits=2)
item group1
group2 vars n mean
sd median trimmed mad min max
X11
1
mh1
control
1 50 15.48 1.67
15
15.53 1.48 12 19
X12
2
mh2
control
1 50 15.32 1.88
15
15.30 1.48 11 20
X133
mh1 experiment
1 47 12.26 2.31
12
12.15 1.48
8 18
X14
4
mh2 experiment
1 47 14.53 2.38
15
14.56 2.97 10 20
range skew kurtosis
seX11
7 -0.17-0.59 0.24
X12
9 0.09-0.28 0.27
X13
10 0.47-0.33 0.34
X14
10 -0.15-0.53 0.35
> # 変数単位> describeBy(d4$y, list(d4$x), mat=TRUE, digits=2)
item group1 vars n mean
sd median trimmed mad min max range skew
X11
1
mh1
1 97 13.92 2.57
14
14.01 2.97
8 19
11 -0.23
X122
mh2
1 97 14.94 2.16
15
14.99 1.48 10 20
10 -0.19
kurtosisseX11-0.84 0.26
X12
-0.15 0.22
> describeBy(d4$y, list(d4$group), mat=TRUE, digits=2)
itemgroup1 vars
n meansd median trimmed mad min max range
X11
1
control
1 100 15.40 1.77
15
15.41 1.48 11 20
9X12
2 experiment
1 94 13.39 2.60
13
13.37 2.97
8 20
12skew kurtosisseX11 -0.04-0.33 0.18
X12 0.14-0.74 0.27>
> # 全体> describe(d4$y)vars
n meansd median trimmed mad min max range skew kurtosis
seX1
1 194 14.43 2.42
15
14.51 2.97
8 20
12 -0.31-0.42 0.17>

> # 分散分析> #aovを使う方法> result.aov <- aov(y ~ group * x + Error(id + id:group + id:group:x), data=d4)
警告メッセージ:# この警告は気にしなくて良いIn aov(y ~ group * x + Error(id + id:group + id:group:x), data = d4) :Error() モデルは特異です> summary(result.aov)Error: id
Df Sum Sq Mean Sq F value
Pr(>F)
group
1 195.1 195.05
39.18 1.11e-08 ***Residuals 95 472.9
4.98--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:group:x
Df Sum Sq Mean Sq F value
Pr(>F)
x
1
50.5
50.52
14.07 0.000303 ***group:x
1
71.9
71.92
20.03 2.12e-05 ***Residuals 95 341.1
3.59--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>

204

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # Anovaを使う方法> library(car)> d1$group <- as.factor(d1$group)> fac.b <- factor(c("mh1","mh2"))> youin <- data.frame(fac.b)> mod.1 <- lm(cbind(mh1, mh2)~group,data=d1)> result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.b)> summary(result.Anova, multivariate=FALSE)
Univariate Type II Repeated-Measures ANOVA Assuming Sphericity
SS num Df Error SS den Df
F
Pr(>F)(Intercept) 40384
1
472.9495 8111.948 < 2.2e-16 ***
group
195
1
472.9495
39.181 1.111e-08 ***
fac.b
51
1
341.0695
14.072 0.0003026 ***group:fac.b
72
1
341.0695
20.032 2.115e-05 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> #平均値を比較する棒グラフの作成> m4t <- tapply(d4$y, list(d4$group$, d4$x), mean)> barplot(m4t, beside=TRUE,legend=TRUE, ylim=c(0,20), las=1, ylab="Mean")> segments(0,0,10,0)>> #ボンフェロニ法を用いた多重比較> d4mh1 <- subset(d4, x=="mh1")> d4mh2 <- subset(d4, x=="mh2")> d4control <- subset(d4, group=="control")> d4experiment <- subset(d4, group=="experiment")>> # mh1でのcontrol群とexperiment群の比較> pairwise.t.test(d4mh1$y, d4mh1$group, paired=FALSE, p.adjust.method="bonferroni")
Pairwise comparisons using t tests with pooled SD
data:

d4mh1$y and d4mh1$groupcontrol
experiment 4.4e-12
P value adjustment method: bonferroni> # mh2でのcontrol群とexperiment群の比較> pairwise.t.test(d4mh2$y, d4mh2$group, paired=FALSE, p.adjust.method="bonferroni")
Pairwise comparisons using t tests with pooled SD
data:

d4mh2$y and d4mh2$groupcontrol
experiment 0.072
P value adjustment method: bonferroni

205名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # control群のmh1とMh2の比較> pairwise.t.test(d4control$y, d4control$x, paired=TRUE, p.adjust.method="bonferroni")
Pairwise comparisons using paired t tests
data:

d4control$y and d4control$x

mh1
mh2 0.63
P value adjustment method: bonferroni> # experiment群のmh1とMh2の比較> pairwise.t.test(d4experiment$y, d4experiment$x, paired=TRUE, p.adjust.method="bonferroni")
Pairwise comparisons using paired t tests
data:

d4experiment$y and d4experiment$x

mh1
mh2 5e-06
P value adjustment method: bonferroni> # 効果量> #eta_squared,omega_sqared関数を使う方法> library(effectsize)> eta_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Eta2 (partial) |95% CI-----------------------------------------------------id|
group |
0.29 | [0.15, 0.43]
id:group:x |x |0.13 | [0.03, 0.26]
id:group:x |group:x |0.17 | [0.06, 0.31]> omega_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Omega2 (partial) |95% CI-------------------------------------------------------id|
group |
0.28 | [0.14, 0.42]
id:group:x |x |0.05 | [0.00, 0.16]
id:group:x |group:x |0.08 | [0.01, 0.20]> eta_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter| Eta2 (partial) |95% CI------------------------------------------group|0.29 | [0.15, 0.43]
fac.b|
0.13 | [0.03, 0.26]
group:fac.b |0.17 | [0.06, 0.31]> omega_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter| Omega2 (partial) |95% CI--------------------------------------------group|0.28 | [0.14, 0.42]
fac.b|
0.05 | [0.00, 0.16]
group:fac.b |0.08 | [0.01, 0.20]>
206

名古屋 大学> #EtaSq関数を使う方法> library(DescTools)> EtaSq(result.aov, type=1)
eta.sq eta.sq.part eta.sq.gen
group
0.17238648
0.2920008 0.19330377
x0.04464965
0.1290165 0.05843784
group:x 0.06355980
0.1741425 0.08117845
>
>

207

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２つの被験者内要因(２Ｗ)
stackデータの作成
条件の組合せごとに各被験者の反応を縦にならべる．すべての条件の組合せについて縦に繋げる．
d2 <- d1[-1]d3 <- stack(d2)d3$x1 <- substr(d3$ind,1,2)
d3$x2 <- substr(d3$ind,3,4)
d3$id <- d1$id
d4 <- d3[,c("id","values", "x1", "x2")]
colnames(d4) <- c("id","y", "x1", "x2")d4$id <- as.factor(d4$id)
d4$x1 <- as.factor(d4$x1)
d4$x2 <- as.factor(d4$x2)
独立変数をfactor型に変換
データフレーム名：d4
被験者ID
：id
被験者内要因1：x1
被験者内要因2：x2
従属変数：y【重要！！】
被験者idも含め，独立変数をfactor型と言われる形式にしておかなければならない関数が多いので，まずこれをやっておく．
factor型にしていないと，間違った分散分析をした結果を出力してしまう．
間違っているかどうかは，「独立変数の自由度Dfの値が“水準数-1”になっているか否か」などでわかる．

分散分析
aovを使う方法
result.aov <- aov(y ~ x1 * x2 + Error(id + id:x1 + id:x2 + id:x1:x2), data=d4)
summary(result.aov)「球面性の仮定」が満たされることを前提としている．
Anovaを使う方法
データフレーム名：d1
被験者ID
：id
被験者内要因名1 ：fac.a <- c(a1, a2)
被験者内要因名2 ：fac.b <- c(b1, b2, b3)
全被験者内要因 ：youin
従属変数：ylibrary(car)fac.a <- factor(c("a1","a1","a1","a2","a2","a2"))
fac.b <- factor(c("b1","b2","b3","b1","b2","b3"))
youin <- data.frame(fac.a, fac.b)mod.1 <- lm(cbind(a1b1, a1b2, a1b3, a2b1, a2b2, a2b3)~1,d1)
result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.a*fac.b)summary(result.Anova, multivariate=FALSE)「球面性の仮定」の検討をして，修正した結果も表示する．
あらかじめ car パッケージをインストールしておく必要がある．
multivariate=TRUE としておくと，多変量分散分析の結果も表示してくれる．

多重比較
被験者内要因pairwise.t.test(d4$y, d4$x1, p.adjust.method="bonferroni", paired=TRUE)
pairwise.t.test(d4$y, d4$x2, p.adjust.method="bonferroni", paired=TRUE)
p.adjusted.method: “holm”,“hochberg”,“hommel”,“bonferroni”,“BH”,“BY”,“fdr”

208

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

効果量
effectsizeパッケージのeta_squared, omega_squared関数を使う方法
library(effectsize)
eta_squared(分散分析オブジェクト, alternative="two.sided")omega_squared(分散分析オブジェクト, alternative="two.sided")
あらかじめeffectsizeパッケージをインストールしておく必要がある．
aov, Anova関数で分散分析を実行した結果オブジェクトをeta_squared, omega_squaredに入れる．
効果量の信頼区間の推定する際，alternative="two.sided" を指定しておくと，下限と上限を推定する信頼区間となる。（指定しない場合，上限は1.00となる。）
DescToolsパッケージのEtaSq関数を使う方法
library(DescTools)
EtaSq(aovオブジェクト, type=1)
各効果について，η2乗，偏η2乗，一般化η2乗を計算する。
あらかじめDescToolsパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqに入れる．
typeオプションでtype=1と指定する．（デフォルトはtype=2）> setwd("d:\\")> d1 <- read.table("2W平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d2 <- d1[-1]> head(d2)cs cd ns nd
1 34 22 36 22
2 36 21 33 17
3 34 25 36 23
4 36 29 32 21
5 36 25 34 21
6 37 23 33 24>>> #stackデータの作成> d3 <- stack(d2)> d3$x1 <- substr(d3$ind,1,1)> d3$x2 <- substr(d3$ind,2,2)> d3$id <- d1$id> d4 <- d3[,c("id","values", "x1", "x2")]> colnames(d4) <- c("id","y", "x1", "x2")> # 独立変数をfactor型に変換> d4$id <- factor(d4$id)> d4$x1 <- factor(d4$x1)> d4$x2 <- factor(d4$x2)> head(d4)id y x1 x2
1 1 34 c s
2 2 36 c s
3 3 34 c s
4 4 36 c s
5 5 36 c s
6 6 37 c s>>> # 各群の人数・平均値・標準偏差209名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 基本統計量> library(psych)>> # セル単位> describeBy(d4$y, list(d4$x1, d4$x2), mat=TRUE, digits=2)
item group1 group2 vars
n meansd median trimmed mad min max range skew kurtosis
se
X11
1
c
d
1 138 23.86 2.70
24
23.90 2.97 15 30
15 -0.32
0.29 0.23X122nd
1 138 21.83 2.58
22
21.91 2.97 14 28
14 -0.28
0.11 0.22
X133cs
1 138 35.06 2.39
35
35.09 1.48 28 44
16 0.01
1.12 0.20
X14
4ns
1 138 33.08 2.56
33
33.02 2.97 28 40
12 0.21-0.48 0.22>
> # 変数単位> describeBy(d4$y, list(d4$x1), mat=TRUE, digits=2)
item group1 vars
n meansd median trimmed mad min max range skew kurtosis
se
X11
1
c
1 276 29.46 6.16
29
29.54 8.9 15 44
29 -0.07-1.32 0.37
X122
n
1 276 27.46 6.19
28
27.47 8.9 14 40
26 -0.01-1.32 0.37
> describeBy(d4$y, list(d4$x2), mat=TRUE, digits=2)
item group1 vars
n meansd median trimmed mad min max range skew kurtosis
se
X11
1
d
1 276 22.84 2.83
23
22.89 2.97 14 30
16 -0.21
0.10 0.17X122s
1 276 34.07 2.67
34
34.09 2.97 28 44
16 0.030.01 0.16>> # 全体> describe(d4$y)vars
n meansd median trimmed mad min max range skew kurtosis
seX1
1 552 28.46 6.25
29
28.51 8.9 14 44
30 -0.04-1.27 0.27>

> # 分散分析> #aovを使う方法> result.aov <- aov(y ~ x1 * x2 + Error(id + id:x1 + id:x2 + id:x1:x2), data=d4)> summary(result.aov)Error: id
Df Sum Sq Mean Sq F value Pr(>F)
Residuals 137
1461
10.66
Error: id:x1
Df Sum Sq Mean Sq F value Pr(>F)
x1
1
552
552.0
98.21 <2e-16 ***Residuals 137
770
5.6--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:x2
Df Sum Sq Mean Sq F value Pr(>F)
x2
1 1738717387
3184 <2e-16 ***Residuals 137748
5--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:x1:x2
Df Sum Sq Mean Sq F value Pr(>F)
x1:x2
1
0.1
0.065
0.014 0.905
Residuals 137 618.9
4.518> # Anovaを使う方法> library(car)> fac.a <- factor(c("c","c","n","n"))> fac.b <- factor(c("s","d","s","d"))> youin <- data.frame(fac.a, fac.b)> mod.1 <- lm(cbind( cs, cd, ns, nd)~1,d1)> result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.a*fac.b)
210

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Note: model has only an intercept; equivalent type-III tests substituted.
> summary(result.Anova, multivariate=FALSE)
Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
SS num Df Error SS den Df
F Pr(>F)(Intercept) 446995
1 1460.96
137 41916.5937 <2e-16 ***
fac.a
552
1
770.00137
98.2130 <2e-16 ***
fac.b
17387
1
748.04
137 3184.3565 <2e-16 ***fac.a:fac.b
01
618.93137
0.0144 0.9045--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1> #ボンフェロニ法を用いた多重比較> d4x1_c <- subset(d4, x1=="c")> d4x1_n <- subset(d4, x1=="n")> d4x2_d <- subset(d4, x2=="d")> d4x2_s <- subset(d4, x2=="s")>> # x1=cでのx2=d群とx2=s群の比較> pairwise.t.test(d4x1_c$y, d4x1_c$x2, paired=TRUE, p.adjust.method="bonferroni")
Pairwise comparisons using paired t tests
data:

d4x1_c$y and d4x1_c$x2ds <2e-16
P value adjustment method: bonferroni>> # x1=nでのx2=d群とx2=s群の比較> pairwise.t.test(d4x1_n$y, d4x1_c$x2, paired=TRUE, p.adjust.method="bonferroni")
Pairwise comparisons using paired t tests
data:

d4x1_n$y and d4x1_c$x2ds <2e-16
P value adjustment method: bonferroni>> # x2=dでのx1=c群とx1=n群の比較> pairwise.t.test(d4x2_d$y, d4x2_d$x1, paired=TRUE, p.adjust.method="bonferroni")
Pairwise comparisons using paired t tests
data:

d4x2_d$y and d4x2_d$x1cn 2.7e-11
P value adjustment method: bonferroni>> # x2=sでのx1=c群とx1=n群の比較> pairwise.t.test(d4x2_s$y, d4x2_s$x1, paired=TRUE, p.adjust.method="bonferroni")
Pairwise comparisons using paired t tests
data:

d4x2_s$y and d4x2_s$x1
211名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

c
n 6.6e-12
P value adjustment method: bonferroni>> #平均値を比較する棒グラフの作成> m4t <- tapply(d4$y, list(d4$x1, d4$x2), mean)> barplot(m4t, beside=TRUE,legend=TRUE, ylim=c(0,40), las=1, ylab="Mean")> segments(0,0, 10,0)> # 効果量> #eta_squared,omega_sqared関数を使う方法> library(effectsize)> eta_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Eta2 (partial) |95% CI---------------------------------------------------id:x1|
x1 |0.42 | [0.30, 0.52]
id:x2
|
x2 |
0.96 | [0.95, 0.97]
id:x1:x2 |x1:x2 |
1.05e-04 | [0.00, 0.02]> omega_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Omega2 (partial) |95% CI-----------------------------------------------------id:x1|
x1 |0.20 | [0.09, 0.31]
id:x2
|
x2 |
0.89 | [0.85, 0.91]
id:x1:x2 |x1:x2 |
0.00 | [0.00, 0.00]> eta_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type III)
Parameter| Eta2 (partial) |95% CI------------------------------------------fac.a|
0.42 | [0.30, 0.52]
fac.b|
0.96 | [0.95, 0.97]
fac.a:fac.b |1.05e-04 | [0.00, 0.02]> omega_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type III)
Parameter| Omega2 (partial) |95% CI--------------------------------------------fac.a|
0.20 | [0.09, 0.31]
fac.b|
0.89 | [0.85, 0.91]
fac.a:fac.b |0.00 | [0.00, 0.00]> #EtaSq関数を使う方法> library(DescTools)> EtaSq(result.aov, type=1)
eta.sq eta.sq.part
eta.sq.gen
x1
2.563036e-02 0.4175491679 1.330144e-01
x2
8.073083e-01 0.9587517931 8.285468e-01
x1:x2 3.028162e-06 0.0001053593 1.812605e-05
212名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

３つの被験者間要因(３Ｂ)
データフレーム名：d1
被験者ID：
id
被験者間要因1：
A
被験者間要因2：
B
被験者間要因3：
C
従属変数：
Y
独立変数の型変換
d1$A <- as.factor(d1$A)
d1$B <- as.factor(d1$B)
d1$C <- as.factor(d1$C)【重要！！】
独立変数をfactor型と言われる形式にしておかなければならない関数が多いので，まずこれをやっておく．
factor型にしていないと，間違った分散分析をした結果を出力してしまう．
間違っているかどうかは，独立変数の自由度Dfの値が「水準数-1」になっているか否かなどでわかる．
分散分析
aovを使う方法
lmオブジェクト名 <- lm(Y ~ A*B*C, data=d1)
aovオブジェクト名 <- aov(lmオブジェクト名)summary(aovオブジェクト名)
anovaを使う方法
lmオブジェクト名 <- lm(Y ~ A*B*C, data=d1)
anovaオブジェクト名 <- anova(lmオブジェクト名)
anovaオブジェクト名
Anovaを使う方法
library(car)lmオブジェクト名 <- lm(Y~A*B*C, data=d1)
Anova オブジェクト名 <- Anova(lmオブジェクト名)
Anova オブジェクト名
あらかじめcarパッケージをインストールしておく必要がある．
被験者間要因が2つあるので，線形モデル(lm)の独立変数を「独立変数1 * 独立変数2」とする．

多重比較 テューキー法
TukeyHSD(aov(Y ~ A*B*C, data=d1) またはTukeyHSD(aovの出力結果)

効果量
各効果について，η2乗，偏η2乗，ω2乗の全部または一部を計算する。
effectsizeパッケージのeta_squared, omega_squared関数を使う方法
library(effectsize)
eta_squared(分散分析オブジェクト, alternative="two.sided")omega_squared(分散分析オブジェクト, alternative="two.sided")
あらかじめeffectsizeパッケージをインストールしておく必要がある．
aov, anova, Anova関数で分散分析を実行した結果オブジェクトをeta_squared, omega_squaredに入れる．
効果量の信頼区間の推定する際，alternative="two.sided" を指定しておくと，下限と上限を推定する信頼区間となる。（指定しない場合，上限は1.00となる。）
DescToolsパッケージのEtaSq関数を使う方法
library(DescTools)
EtaSq(aovオブジェクト)
あらかじめDescToolsパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqに入れる．
typeオプションで平方和のタイプを選択できる．デフォルトはタイプ2．
213

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

lsrパッケージのetaSquared関数を使う方法
library(lsr)
etaSquared(aovオブジェクト)
あらかじめlsrパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqqaredに入れる．
typeオプションで平方和のタイプを選択できる．デフォルトはタイプ2．

> setwd("d:\\")> d1 <- read.table("3B平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id A B C Y
1 1 a1 b1 c1 8
2 2 a1 b1 c1 6
3 3 a1 b1 c1 8
4 4 a1 b1 c1 95 5 a1 b1 c1 86 6 a1 b1 c2 9>>
> # 独立変数をfactor型に変換> d1$id <- factor(d1$id)> d1$A <- factor(d1$A)> d1$B <- factor(d1$B)> d1$C <- factor(d1$C)> head(d1)id A B C Y
1 1 a1 b1 c1 8
2 2 a1 b1 c1 6
3 3 a1 b1 c1 8
4 4 a1 b1 c1 95 5 a1 b1 c1 86 6 a1 b1 c2 9>>>

> # 各群の人数・平均値・標準偏差> library(psych)> (tABC <- describeBy(d1$Y, list(d1$A, d1$B, d1$C), mat=TRUE, digits=2))
item group1 group2 group3 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
b1
c1
1 5 7.8 1.108
7.8 0.00
6
9
3 -0.62-1.25 0.49
X12
2
a2
b1
c1
1 5 2.8 0.84
3
2.8 1.48
2
4
2 0.25-1.82 0.37
X13
3
a1
b2
c1
1 5 9.4 2.07
10
9.4 1.48
6 11
5 -0.69-1.41 0.93
X14
4
a2
b2
c1
1 5 3.8 2.49
3
3.8 1.48
28
6 0.80-1.27 1.11
X15
5
a1
b3
c1
1 5 7.2 0.84
7
7.2 1.48
6
8
2 -0.25-1.82 0.37
X16
6
a2
b3
c1
1 5 13.0 1.87
12
13.0 1.48 11 15
4 0.18-2.18 0.84
X17
7
a1
b1
c2
1 5 7.2 1.30
7
7.2 1.48
6
9
3 0.26-1.96 0.58
X18
8
a2
b1
c2
1 5 4.4 1.52
4
4.4 0.00
37
4 0.84-1.12 0.68
X19
9
a1
b2
c2
1 5 6.0 2.55
6
6.0 1.48
3 10
7 0.43-1.40 1.14
X110
10
a2
b2
c2
1 5 7.6 2.88
6
7.6 1.48
5 12
7 0.52-1.73 1.29
X111
11
a1
b3
c2
1 5 7.0 1.00
7
7.0 1.48
68
2 0.00-2.20 0.45
X112
12
a2
b3
c2
1 5 13.4 1.67
13
13.4 2.97 11 15
4 -0.25-1.82 0.75>
> (tAB <- describeBy(d1$Y, list(d1$A, d1$B), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
b1
1 10 7.5 1.18
8.0
7.50 1.48
6
9
3 -0.18-1.67 0.37
X12
2
a2
b1
1 10 3.6 1.43
3.5
3.38 0.74
27
5 1.050.52 0.45
X13
3
a1
b2
1 10 7.7 2.83
7.5
7.88 3.71
3 11
8 -0.18-1.66 0.90
X14
4
a2
b2
1 10 5.7 3.23
5.5
5.38 3.71
2 12
10 0.51-1.03 1.02
X15
5
a1
b3
1 10 7.1 0.88
7.0
7.12 1.48
68
2 -0.16-1.81 0.28
X16
6
a2
b3
1 10 13.2 1.69
13.0
13.25 2.97 11 15
4 -0.03-1.85 0.53
214

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> (tAC <- describeBy(d1$Y, list(d1$A, d1$C), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
c1
1 15 8.13 1.64
8
8.08 1.48
6 11
5 0.34-1.04 0.42
X12
2
a2
c1
1 15 6.53 5.05
4
6.23 2.97
2 15
13 0.57-1.50 1.31
X13
3
a1
c2
1 15 6.73 1.71
6
6.77 1.48
3 10
7 -0.09-0.25 0.44
X14
4
a2
c2
1 15 8.47 4.32
7
8.38 4.45
3 15
12 0.25-1.67 1.12>
> (tBC <- describeBy(d1$Y, list(d1$B, d1$C), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
b1
c1
1 10 5.3 2.79
5.0
5.25 4.45
2
9
7 0.05-1.94 0.88
X12
2
b2
c1
1 10 6.6 3.66
7.0
6.62 5.19
2 11
9 -0.07-1.87 1.16
X13
3
b3
c1
1 10 10.1 3.35
9.5
10.00 3.71
6 15
9 0.27-1.66 1.06
X14
4
b1
c2
1 10 5.8 1.99
6.0
5.75 2.97
39
6 0.09-1.56 0.63
X15
5
b2
c2
1 10 6.8 2.70
6.0
6.62 1.48
3 12
9 0.59-0.95 0.85
X16
6
b3
c2
1 10 10.2 3.61
9.5
10.12 5.19
6 15
9 0.13-1.85 1.14>
> (tA <- describeBy(d1$Y, list(d1$A), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
1 30 7.43 1.79
7.5
7.38 2.22
3 11
8 0.05-0.14 0.33
X122
a2
1 30 7.50 4.73
6.0
7.25 5.19
2 15
13 0.35-1.52 0.86>
> (tB <- describeBy(d1$Y, list(d1$B), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
b1
1 20 5.55 2.37
6.0
5.56 2.97
29
7 -0.03-1.57 0.53
X122
b2
1 20 6.70 3.13
6.0
6.69 4.45
2 12
10 0.11-1.34 0.70
X13
3
b3
1 20 10.15 3.39
9.5
10.06 3.71
6 15
9 0.22-1.62 0.76>
> (tC <- describeBy(d1$Y, list(d1$C), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
c1
1 30 7.33 3.78
8.0
7.17 4.45
2 15
13 0.22-0.88 0.69
X122
c2
1 30 7.60 3.35
6.5
7.29 2.22
3 15
12 0.77-0.40 0.61>
> (tall <- describe(d1$Y))vars n mean
sd median trimmed mad min max range skew kurtosisseX1
1 60 7.47 3.54
7
7.25 2.97
2 15
13 0.44-0.55 0.46>>>
> #分散分析> # aovを使う方法> mod.1 <- lm(Y~A*B*C, data=d1)> result.aov <- aov(mod.1)> summary(result.aov)
Df Sum Sq Mean Sq F value
Pr(>F)
A
1
0.07
0.07
0.020 0.88700
B
2 229.23 114.62 35.087 4.07e-10 ***
C
1
1.07
1.07
0.327 0.57038
A:B
2 282.03 141.02 43.168 1.88e-11 ***A:C
1 41.67
41.67 12.755 0.00082 ***
B:C
2
0.43
0.22
0.066 0.93591
A:B:C
2 29.63
14.82
4.536 0.01569 *Residuals
48 156.80
3.27--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> # anovaを使う方法> mod.1 <- lm(Y~A*B*C, data=d1)> result.anova <- anova(mod.1)> result.anova
Analysis of Variance Table215

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Response: Y
Df Sum Sq Mean Sq F value
Pr(>F)
A
1
0.067
0.067 0.0204 0.8870010
B
2 229.233 114.617 35.0867 4.067e-10 ***
C
1
1.067
1.067 0.3265 0.5703753
A:B
2 282.033 141.017 43.1684 1.875e-11 ***A:C
1 41.667 41.667 12.7551 0.0008196 ***
B:C
2
0.433
0.217 0.0663 0.9359109
A:B:C
2 29.633 14.817 4.5357 0.0156942 *Residuals 48 156.800
3.267--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> # Anovaを使う方法> library(car)> mod.1 <- lm(Y~A*B*C, data=d1)> result.Anova <- Anova(mod.1)> result.Anova
Anova Table (Type II tests)
Response: Y
Sum Sq Df F value
Pr(>F)
A
0.067 1 0.0204 0.8870010
B
229.233 2 35.0867 4.067e-10 ***C
1.067 1 0.3265 0.5703753
A:B
282.033 2 43.1684 1.875e-11 ***A:C
41.667 1 12.7551 0.0008196 ***B:C
0.433 2 0.0663 0.9359109
A:B:C
29.633 2 4.5357 0.0156942 *Residuals 156.800 48--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>>>> #多重比較> #テューキーの方法> (mc.tukey <- TukeyHSD(result.aov))Tukey multiple comparisons of means
95% family-wise confidence level
Fit: aov(formula = mod.1)
$A
diff
lwr
upr
p adj
a2-a1 0.06666667 -0.8716296 1.004963 0.887001
$B
diff
lwr
upr
p adj
b2-b1 1.15 -0.2322808 2.532281 0.1202186
b3-b1 4.60 3.2177192 5.982281 0.0000000
b3-b2 3.45 2.0677192 4.832281 0.0000007
$C
diff
lwr
upr
p adj
c2-c1 0.2666667 -0.6716296 1.204963 0.5703753$`A:B`
diff
lwr
upr
p adj
a2:b1-a1:b1 -3.9 -6.2989208 -1.5010792 0.0002027
a1:b2-a1:b1 0.2 -2.1989208 2.5989208 0.9998650
a2:b2-a1:b1 -1.8 -4.1989208 0.5989208 0.2447676
a1:b3-a1:b1 -0.4 -2.7989208 1.9989208 0.9961341
a2:b3-a1:b1 5.7 3.3010792 8.0989208 0.0000001
a1:b2-a2:b1 4.1 1.7010792 6.4989208 0.0000886
a2:b2-a2:b1 2.1 -0.2989208 4.4989208 0.1174879
a1:b3-a2:b1 3.5 1.1010792 5.8989208 0.0010129
216

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

a2:b3-a2:b1 9.6 7.2010792 11.9989208 0.0000000
a2:b2-a1:b2 -2.0 -4.3989208 0.3989208 0.1522895
a1:b3-a1:b2 -0.6 -2.9989208 1.7989208 0.9754862
a2:b3-a1:b2 5.5 3.1010792 7.8989208 0.0000002
a1:b3-a2:b2 1.4 -0.9989208 3.7989208 0.5181172
a2:b3-a2:b2 7.5 5.1010792 9.8989208 0.0000000
a2:b3-a1:b3 6.1 3.7010792 8.4989208 0.0000000$`A:C`
diff
lwr
upr
p adj
a2:c1-a1:c1 -1.6000000 -3.3564161 0.1564161 0.0859930
a1:c2-a1:c1 -1.4000000 -3.1564161 0.3564161 0.1609853
a2:c2-a1:c1 0.3333333 -1.4230828 2.0897495 0.9574880
a1:c2-a2:c1 0.2000000 -1.5564161 1.9564161 0.9902117
a2:c2-a2:c1 1.9333333 0.1769172 3.6897495 0.0257796
a2:c2-a1:c2 1.7333333 -0.0230828 3.4897495 0.0543105$`B:C`

diff
lwr
upr
p adj
b2:c1-b1:c1 1.3 -1.0989208 3.6989208 0.5972275
b3:c1-b1:c1 4.8 2.4010792 7.1989208 0.0000045
b1:c2-b1:c1 0.5 -1.8989208 2.8989208 0.9891291
b2:c2-b1:c1 1.5 -0.8989208 3.8989208 0.4411593
b3:c2-b1:c1 4.9 2.5010792 7.2989208 0.0000029
b3:c1-b2:c1 3.5 1.1010792 5.8989208 0.0010129
b1:c2-b2:c1 -0.8 -3.1989208 1.5989208 0.9189969
b2:c2-b2:c1 0.2 -2.1989208 2.5989208 0.9998650
b3:c2-b2:c1 3.6 1.2010792 5.9989208 0.0006821
b1:c2-b3:c1 -4.3 -6.6989208 -1.9010792 0.0000382
b2:c2-b3:c1 -3.3 -5.6989208 -0.9010792 0.0021977
b3:c2-b3:c1 0.1 -2.2989208 2.4989208 0.9999957
b2:c2-b1:c2 1.0 -1.3989208 3.3989208 0.8164137
b3:c2-b1:c2 4.4 2.0010792 6.7989208 0.0000250
b3:c2-b2:c2 3.4 1.0010792 5.7989208 0.0014962$`A:B:C`diff
a2:b1:c1-a1:b1:c1 -5.000000e+00
a1:b2:c1-a1:b1:c1 1.600000e+00
a2:b2:c1-a1:b1:c1 -4.000000e+00
a1:b3:c1-a1:b1:c1 -6.000000e-01
a2:b3:c1-a1:b1:c1 5.200000e+00
a1:b1:c2-a1:b1:c1 -6.000000e-01
a2:b1:c2-a1:b1:c1 -3.400000e+00
a1:b2:c2-a1:b1:c1 -1.800000e+00
a2:b2:c2-a1:b1:c1 -2.000000e-01
a1:b3:c2-a1:b1:c1 -8.000000e-01
a2:b3:c2-a1:b1:c1 5.600000e+00
a1:b2:c1-a2:b1:c1 6.600000e+00
a2:b2:c1-a2:b1:c1 1.000000e+00
a1:b3:c1-a2:b1:c1 4.400000e+00
a2:b3:c1-a2:b1:c1 1.020000e+01
a1:b1:c2-a2:b1:c1 4.400000e+00
a2:b1:c2-a2:b1:c1 1.600000e+00
a1:b2:c2-a2:b1:c1 3.200000e+00
a2:b2:c2-a2:b1:c1 4.800000e+00
a1:b3:c2-a2:b1:c1 4.200000e+00
a2:b3:c2-a2:b1:c1 1.060000e+01
a2:b2:c1-a1:b2:c1 -5.600000e+00
a1:b3:c1-a1:b2:c1 -2.200000e+00
a2:b3:c1-a1:b2:c1 3.600000e+00
a1:b1:c2-a1:b2:c1 -2.200000e+00
a2:b1:c2-a1:b2:c1 -5.000000e+00
a1:b2:c2-a1:b2:c1 -3.400000e+00
a2:b2:c2-a1:b2:c1 -1.800000e+00
a1:b3:c2-a1:b2:c1 -2.400000e+00
a2:b3:c2-a1:b2:c1 4.000000e+00
a1:b3:c1-a2:b2:c1 3.400000e+00
a2:b3:c1-a2:b2:c1 9.200000e+00
a1:b1:c2-a2:b2:c1 3.400000e+00
a2:b1:c2-a2:b2:c1 6.000000e-01
a1:b2:c2-a2:b2:c1 2.200000e+00

lwr
upr
p adj
-8.92508183 -1.07491817 0.0034084-2.32508183 5.52508183 0.9579810-7.92508183 -0.07491817 0.0422093-4.52508183 3.32508183 0.9999940
1.27491817 9.12508183 0.0019706-4.52508183 3.32508183 0.9999940-7.32508183 0.52508183 0.1482991-5.72508183 2.12508183 0.9097357-4.12508183 3.72508183 1.0000000-4.72508183 3.12508183 0.9998906
1.67491817 9.52508183 0.0006381
2.67491817 10.52508183 0.0000334-2.92508183 4.92508183 0.9990898
0.47491817 8.32508183 0.0162497
6.27491817 14.12508183 0.0000000
0.47491817 8.32508183 0.0162497-2.32508183 5.52508183 0.9579810-0.72508183 7.12508183 0.2128271
0.87491817 8.72508183 0.0058219
0.27491817 8.12508183 0.0264537
6.67491817 14.52508183 0.0000000-9.52508183 -1.67491817 0.0006381-6.12508183 1.72508183 0.7384436-0.32508183 7.52508183 0.1002066-6.12508183 1.72508183 0.7384436-8.92508183 -1.07491817 0.0034084-7.32508183 0.52508183 0.1482991-5.72508183 2.12508183 0.9097357-6.32508183 1.52508183 0.6254360
0.07491817 7.92508183 0.0422093-0.52508183 7.32508183 0.1482991
5.27491817 13.12508183 0.0000000-0.52508183 7.32508183 0.1482991-3.32508183 4.52508183 0.9999940-1.72508183 6.12508183 0.7384436
217名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

a2:b2:c2-a2:b2:c1 3.800000e+00 -0.12508183 7.72508183 0.0658543
a1:b3:c2-a2:b2:c1 3.200000e+00 -0.72508183 7.12508183 0.2128271
a2:b3:c2-a2:b2:c1 9.600000e+00
5.67491817 13.52508183 0.0000000
a2:b3:c1-a1:b3:c1 5.800000e+00
1.87491817 9.72508183 0.0003583
a1:b1:c2-a1:b3:c1 8.881784e-16 -3.92508183 3.92508183 1.0000000
a2:b1:c2-a1:b3:c1 -2.800000e+00 -6.72508183 1.12508183 0.3948439
a1:b2:c2-a1:b3:c1 -1.200000e+00 -5.12508183 2.72508183 0.9954470
a2:b2:c2-a1:b3:c1 4.000000e-01 -3.52508183 4.32508183 0.9999999
a1:b3:c2-a1:b3:c1 -2.000000e-01 -4.12508183 3.72508183 1.0000000
a2:b3:c2-a1:b3:c1 6.200000e+00
2.27491817 10.12508183 0.0001106
a1:b1:c2-a2:b3:c1 -5.800000e+00 -9.72508183 -1.87491817 0.0003583
a2:b1:c2-a2:b3:c1 -8.600000e+00 -12.52508183 -4.67491817 0.0000001
a1:b2:c2-a2:b3:c1 -7.000000e+00 -10.92508183 -3.07491817 0.0000099
a2:b2:c2-a2:b3:c1 -5.400000e+00 -9.32508183 -1.47491817 0.0011268
a1:b3:c2-a2:b3:c1 -6.000000e+00 -9.92508183 -2.07491817 0.0001997
a2:b3:c2-a2:b3:c1 4.000000e-01 -3.52508183 4.32508183 0.9999999
a2:b1:c2-a1:b1:c2 -2.800000e+00 -6.72508183 1.12508183 0.3948439
a1:b2:c2-a1:b1:c2 -1.200000e+00 -5.12508183 2.72508183 0.9954470
a2:b2:c2-a1:b1:c2 4.000000e-01 -3.52508183 4.32508183 0.9999999
a1:b3:c2-a1:b1:c2 -2.000000e-01 -4.12508183 3.72508183 1.0000000
a2:b3:c2-a1:b1:c2 6.200000e+00
2.27491817 10.12508183 0.0001106
a1:b2:c2-a2:b1:c2 1.600000e+00 -2.32508183 5.52508183 0.9579810
a2:b2:c2-a2:b1:c2 3.200000e+00 -0.72508183 7.12508183 0.2128271
a1:b3:c2-a2:b1:c2 2.600000e+00 -1.32508183 6.52508183 0.5074523
a2:b3:c2-a2:b1:c2 9.000000e+00
5.07491817 12.92508183 0.0000000
a2:b2:c2-a1:b2:c2 1.600000e+00 -2.32508183 5.52508183 0.9579810
a1:b3:c2-a1:b2:c2 1.000000e+00 -2.92508183 4.92508183 0.9990898
a2:b3:c2-a1:b2:c2 7.400000e+00
3.47491817 11.32508183 0.0000029
a1:b3:c2-a2:b2:c2 -6.000000e-01 -4.52508183 3.32508183 0.9999940
a2:b3:c2-a2:b2:c2 5.800000e+00
1.87491817 9.72508183 0.0003583
a2:b3:c2-a1:b3:c2 6.400000e+00
2.47491817 10.32508183 0.0000609> #シェッフェの方法> library(agricolae)> (mc.scheffe <- scheffe.test(result.aov, "A"))$statistics
MSerror DfF
Mean
CV Scheffe CriticalDifference
3.266667 48 4.042652 7.466667 24.20615 2.010635
0.9382962$parameters
test name.t ntr alphaScheffeA
2 0.05$meansY
std r Min Max Q25 Q50 Q75
a1 7.433333 1.794308 30
3 11 6.00 7.5
8
a2 7.500000 4.725208 30
2 15 3.25 6.0 12$comparison
NULL$groupsY groups
a2 7.500000
aa1 7.433333
a
attr(,"class")[1] "group"> (mc.scheffe <- scheffe.test(result.aov, "B"))$statistics
MSerror DfF
Mean
CV Scheffe CriticalDifference
3.266667 48 3.190727 7.466667 24.20615 2.526154
1.443817$parameters
test name.t ntr alphaScheffeB
3 0.05218

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部$meansY
std r Min Max Q25 Q50
Q75
b1 5.55 2.372540 202
9 3.75 6.0 8.00
b2 6.70 3.130495 20
2 12 4.75 6.0 9.25
b3 10.15 3.391553 20
6 15 7.00 9.5 13.00$comparison
NULL$groupsY groups
b3 10.15
ab2 6.70bb1 5.55b
attr(,"class")[1] "group"> (mc.scheffe <- scheffe.test(result.aov, "C"))$statistics
MSerror DfF
Mean
CV Scheffe CriticalDifference
3.266667 48 4.042652 7.466667 24.20615 2.010635
0.9382962$parameters
test name.t ntr alphaScheffeC
2 0.05$meansY
std r Min Max Q25 Q50 Q75
c1 7.333333 3.781382 30
2 15
4 8.0 9.75
c2 7.600000 3.348700 30
3 15
6 6.5 9.00
$comparison
NULL$groupsY groups
c2 7.600000
ac1 7.333333
a
attr(,"class")[1] "group"> # group=FALSE を指定したシェッフェの方法> (mc.scheffe <- scheffe.test(result.aov, "A", group=FALSE))$statistics
MSerror DfF
Mean
CV Scheffe CriticalDifference
3.266667 48 4.042652 7.466667 24.20615 2.010635
0.9382962$parameters
test name.t ntr alphaScheffeA
2 0.05$meansY
std r Min Max Q25 Q50 Q75
a1 7.433333 1.794308 30
3 11 6.00 7.5
8
a2 7.500000 4.725208 30
2 15 3.25 6.0 12$comparison
Difference pvalue sig
LCL
UCL
a1 - a2 -0.06666667 0.887-0.7283853 0.595052$groupsNULL
attr(,"class")[1] "group"219

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> (mc.scheffe <- scheffe.test(result.aov, "B", group=FALSE))$statistics
MSerror DfF
Mean
CV Scheffe CriticalDifference
3.266667 48 3.190727 7.466667 24.20615 2.526154
1.443817$parameters
test name.t ntr alphaScheffeB
3 0.05$meansY
std r Min Max Q25 Q50
Q75
b1 5.55 2.372540 202
9 3.75 6.0 8.00
b2 6.70 3.130495 20
2 12 4.75 6.0 9.25
b3 10.15 3.391553 20
6 15 7.00 9.5 13.00$comparison
Difference pvalue sig
LCL
UCL
b1 - b2-1.15 0.1432-2.434687 0.134687
b1 - b3-4.60 0.0000 *** -5.884687 -3.315313
b2 - b3-3.45 0.0000 *** -4.734687 -2.165313$groupsNULL
attr(,"class")[1] "group"> (mc.scheffe <- scheffe.test(result.aov, "C", group=FALSE))$statistics
MSerror DfF
Mean
CV Scheffe CriticalDifference
3.266667 48 4.042652 7.466667 24.20615 2.010635
0.9382962$parameters
test name.t ntr alphaScheffeC
2 0.05$meansY
std r Min Max Q25 Q50 Q75
c1 7.333333 3.781382 30
2 15
4 8.0 9.75
c2 7.600000 3.348700 30
3 15
6 6.5 9.00
$comparison
Difference pvalue sig
LCL
UCL
c1 - c2 -0.2666667 0.5704-0.9283853 0.395052$groupsNULL
attr(,"class")[1] "group"
>
>
>
>

220

名古屋 大学> # 効果量> #eta_squared,omega_squared関数を使う方法> library(effectsize)> eta_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter | Eta2 (partial) |95% CI----------------------------------------A|
4.25e-04 | [0.00, 0.06]
B|
0.59 | [0.40, 0.71]
C|
6.76e-03 | [0.00, 0.12]
A:B|
0.64 | [0.47, 0.75]
A:C|
0.21 | [0.04, 0.40]
B:C|
2.76e-03 | [0.00, 0.04]
A:B:C|
0.16 | [0.01, 0.34]> omega_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter | Omega2 (partial) |95% CI------------------------------------------A|
0.00 | [0.00, 0.00]
B|
0.53 | [0.33, 0.66]
C|
0.00 | [0.00, 0.00]
A:B|
0.58 | [0.39, 0.70]
A:C|
0.16 | [0.02, 0.35]
B:C|
0.00 | [0.00, 0.00]
A:B:C|
0.11 | [0.00, 0.27]> eta_squared(result.anova, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter | Eta2 (partial) |95% CI----------------------------------------A|
4.25e-04 | [0.00, 0.06]
B|
0.59 | [0.40, 0.71]
C|
6.76e-03 | [0.00, 0.12]
A:B|
0.64 | [0.47, 0.75]
A:C|
0.21 | [0.04, 0.40]
B:C|
2.76e-03 | [0.00, 0.04]
A:B:C|
0.16 | [0.01, 0.34]> omega_squared(result.anova, alternative="two.sided")# Effect Size for ANOVA (Type I)
Parameter | Omega2 (partial) |95% CI------------------------------------------A|
0.00 | [0.00, 0.00]
B|
0.53 | [0.33, 0.66]
C|
0.00 | [0.00, 0.00]
A:B|
0.58 | [0.39, 0.70]
A:C|
0.16 | [0.02, 0.35]
B:C|
0.00 | [0.00, 0.00]
A:B:C|
0.11 | [0.00, 0.27]>

221

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学> eta_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter | Eta2 (partial) |95% CI----------------------------------------A|
4.25e-04 | [0.00, 0.06]
B|
0.59 | [0.40, 0.71]
C|
6.76e-03 | [0.00, 0.12]
A:B|
0.64 | [0.47, 0.75]
A:C|
0.21 | [0.04, 0.40]
B:C|
2.76e-03 | [0.00, 0.04]
A:B:C|
0.16 | [0.01, 0.34]> omega_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter | Omega2 (partial) |95% CI------------------------------------------A|
0.00 | [0.00, 0.00]
B|
0.53 | [0.33, 0.66]
C|
0.00 | [0.00, 0.00]
A:B|
0.58 | [0.39, 0.70]
A:C|
0.16 | [0.02, 0.35]
B:C|
0.00 | [0.00, 0.00]
A:B:C|
0.11 | [0.00, 0.27]> #EtaSq関数を使う方法> library(DescTools)> EtaSq(result.aov)eta.sq eta.sq.partA
8.997661e-05 0.0004249894
B
3.093846e-01 0.5938174596
C
1.439626e-03 0.0067567568
A:B
3.806460e-01 0.6426889480
A:C
5.623538e-02 0.2099428955
B:C
5.848479e-04 0.0027559890
A:B:C 3.999460e-02 0.1589486859> #etaSquared関数を使う方法> library(lsr)> etaSquared(result.aov)eta.sq eta.sq.partA
8.997661e-05 0.0004249894
B
3.093846e-01 0.5938174596
C
1.439626e-03 0.0067567568
A:B
3.806460e-01 0.6426889480
A:C
5.623538e-02 0.2099428955
B:C
5.848479e-04 0.0027559890
A:B:C 3.999460e-02 0.1589486859> # 単純効果> library(phia)>> # B*Cの各水準におけるAの主効果> testInteractions(mod.1, fixed=c("B","C"), across="A")
F Test:P-value adjustment method: holm
Value Df Sum of Sq
F
Pr(>F)
b1 : c1
5.0 162.5 19.1327 0.0001961 ***b2 : c1
5.6 1
78.4 24.0000 4.545e-05 ***b3 : c1-5.8 1
84.1 25.7449 3.132e-05 ***222

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

b1 : c2
2.8 1
19.6 6.0000 0.0360117 *b2 : c2-1.6 1
6.4 1.9592 0.1680307
b3 : c2-6.4 1102.4 31.3469 6.131e-06 ***Residuals48
156.8--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> # A*Cの各水準におけるBの2水準間の効果> testInteractions(mod.1, fixed=c("A","C"), pairwise="B")
F Test:P-value adjustment method: holm
Value Df Sum of Sq
F
Pr(>F)
b1-b2 : a1 : c1 -1.6 1
6.4 1.9592
1.00000
b1-b3 : a1 : c1
0.6 1
0.9 0.2755
1.00000
b2-b3 : a1 : c1
2.2 1
12.1 3.7041
0.42153
b1-b2 : a2 : c1 -1.0 1
2.5 0.7653
1.00000
b1-b3 : a2 : c1 -10.2 1
260.1 79.6224 1.104e-10 ***b2-b3 : a2 : c1 -9.2 1
211.6 64.7755 2.048e-09 ***b1-b2 : a1 : c2
1.2 1
3.6 1.1020
1.00000
b1-b3 : a1 : c2
0.2 1
0.1 0.0306
1.00000
b2-b3 : a1 : c2 -1.0 1
2.5 0.7653
1.00000
b1-b2 : a2 : c2 -3.2 1
25.6 7.8367
0.05882 .
b1-b3 : a2 : c2 -9.0 1
202.5 61.9898 3.423e-09 ***b2-b3 : a2 : c2 -5.8 1
84.1 25.7449 5.638e-05 ***Residuals48
156.8--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
>
>
>
>
> #平均値を比較する棒グラフの作成> d1t <- d1[d1$C=="c1",]> m1t <- tapply(d1t[,"Y"], list(d1t[,"A"], d1t[,"B"]), mean)> barplot(m1t, beside=TRUE,legend=TRUE, ylim=c(0,20), ylab="Mean", main="C=c1")> segments(0,0,10,0)>> d1t <- d1[d1$C=="c2",]> m1t <- tapply(d1t[,"Y"], list(d1t[,"A"], d1t[,"B"]), mean)> barplot(m1t, beside=TRUE,legend=TRUE, ylim=c(0,20), ylab="Mean", main="C=c2")> segments(0,0,10,0)
>
>
>

223

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２つの被験者間要因と１つの被験者内要因(２Ｂ１Ｗ)
stackデータの作成
被験者内要因の水準ごとにstackデータを作成して，最後に縦に繋げる
vn.x <- c("c1","c2")d3 <- NULL
for(i in vn.x){d2 <- d1
d2$C <- id2$Y <- d1[,i]d3 <- rbind(d3,d2)}
d4<- d3[,c("id","A","B","C","Y")]d4$id <- as.factor(d4$id)
d4$A <- as.factor(d4$A)
d4$B <- as.factor(d4$B)
d4$C <- as.factor(d4$C)
head(d4)
データフレーム名 ：d4
被験者ID
：id
被験者間要因変数1：A
被験者間要因変数2：B
被験者内要因変数 ：C
従属変数：Y【重要！！】
被験者idも含め，独立変数をfactor型と言われる形式にしておかなければならない関数が多いので，まずこれをやっておく．
factor型にしていないと，間違った分散分析をした結果を出力してしまう．
間違っているかどうかは，独立変数の自由度Dfの値が「水準数-1」になっているか否かなどでわかる．

分散分析
aovを使う方法
result.aov <- aov(Y ~ A*B*C + Error(id + id:A:B + id:A:B:C), data=d4)
summary(result.aov)「球面性の仮定」が満たされることを前提としている．
Anovaを使う方法
データフレーム 名：d1
被験者ID
：id
被験者間要因変数1：A
被験者間要因変数2：B
被験者内要因名：fac.c <- factor(c("c1", "c2"))
全被験者内要因：youin従属変数：Ylibrary(car)d1$A <- as.factor(d1$A)
d1$B <- as.factor(d1$B)
fac.c <- factor(c("c1","c2"))
youin <- data.frame(fac.c)mod.1 <- lm(cbind(c1,c2)~A*B,data=d1)
result.ANOVA <- Anova(mod.1, idata=youin, idesign=~fac.c)summary(result.Anova, multivariate=FALSE)「球面性の仮定」の検討をして，修正した結果も表示する．
あらかじめcarパッケージをインストールしておく必要がある．
multivariate=TRUE としておくと，多変量分散分析の結果も表示してくれる．

多重比較
被験者間要因pairwise.t.test(d1$Y, d1$A, p.adjust.method="bonferroni")224名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

被験者内要因pairwise.t.test(d1$Y, d1$C, p.adjust.method="bonferroni", paired=TRUE)
p.adjusted.method: “holm”,“hochberg”,“hommel”,“bonferroni”,“BH”,“BY”,“fdr”

効果量effectsizeパッケージのeta_squared, omega_squared関数を使う方法
library(effectsize)
eta_squared(分散分析オブジェクト, alternative="two.sided")omega_squared(分散分析オブジェクト, alternative="two.sided")
あらかじめeffectsizeパッケージをインストールしておく必要がある．
aov, Anova関数で分散分析を実行した結果オブジェクトをeta_squared, omega_squaredに入れる．
効果量の信頼区間の推定する際，alternative="two.sided" を指定しておくと，下限と上限を推定する信頼区間となる。（指定しない場合，上限は1.00となる。）
DescToolsパッケージのEtaSq関数を使う方法
library(DescTools)
EtaSq(aovオブジェクト, type=1)
各効果について，η2乗，偏η2乗，一般化η2乗の値を計算する．
あらかじめDescToolsパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqに入れる．
typeオプションでtype=1と指定する。（デフォルトはtype=2）> setwd("di:\\")> d1 <- read.table("ANOVA_2B1W.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id A B c1 c2
1 1 a1 b1 8 9
2 2 a1 b1 6 6
3 3 a1 b1 8 8
4 4 a1 b1 9 6
5 5 a1 b1 8 7
6 6 a1 b2 6 10>>
> # stackデータの作成> vn.x <- c("c1","c2")> d3 <- NULL
> for(i in vn.x){+ d2 <- d1+ d2$C <- i
+ d2$Y <- d1[,i]+ d3 <- rbind(d3,d2)+ }> d4<- d3[,c("id","A","B","C","Y")]> d4$id <- as.factor(d4$id)> d4$A <- as.factor(d4$A)> d4$B <- as.factor(d4$B)> d4$C <- as.factor(d4$C)> head(d4)id A B C Y
1 1 a1 b1 c1 8
2 2 a1 b1 c1 6
3 3 a1 b1 c1 8
4 4 a1 b1 c1 95 5 a1 b1 c1 86 6 a1 b2 c1 6
>
>
>
225

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> #各群の人数・平均値・標準偏差> library(psych)> (tABC <- describeBy(d4$Y, list(d4$A, d4$B, d4$C), mat=TRUE, digits=2))
item group1 group2 group3 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
b1
c1
1 5 7.8 1.108
7.8 0.00
6
9
3 -0.62-1.25 0.49
X12
2
a2
b1
c1
1 5 2.8 0.84
3
2.8 1.48
2
4
2 0.25-1.82 0.37
X13
3
a1
b2
c1
1 5 9.4 2.07
10
9.4 1.48
6 11
5 -0.69-1.41 0.93
X14
4
a2
b2
c1
1 5 3.8 2.49
3
3.8 1.48
28
6 0.80-1.27 1.11
X15
5
a1
b3
c1
1 5 7.2 0.84
7
7.2 1.48
6
8
2 -0.25-1.82 0.37
X16
6
a2
b3
c1
1 5 13.0 1.87
12
13.0 1.48 11 15
4 0.18-2.18 0.84
X17
7
a1
b1
c2
1 5 7.2 1.30
7
7.2 1.48
6
9
3 0.26-1.96 0.58
X18
8
a2
b1
c2
1 5 4.4 1.52
4
4.4 0.00
37
4 0.84-1.12 0.68
X19
9
a1
b2
c2
1 5 6.0 2.55
6
6.0 1.48
3 10
7 0.43-1.40 1.14
X110
10
a2
b2
c2
1 5 7.6 2.88
6
7.6 1.48
5 12
7 0.52-1.73 1.29
X111
11
a1
b3
c2
1 5 7.0 1.00
7
7.0 1.48
68
2 0.00-2.20 0.45
X112
12
a2
b3
c2
1 5 13.4 1.67
13
13.4 2.97 11 15
4 -0.25-1.82 0.75>
> (tAB <- describeBy(d4$Y, list(d4$A, d4$B), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
b1
1 10 7.5 1.18
8.0
7.50 1.48
6
9
3 -0.18-1.67 0.37
X12
2
a2
b1
1 10 3.6 1.43
3.5
3.38 0.74
27
5 1.050.52 0.45
X13
3
a1
b2
1 10 7.7 2.83
7.5
7.88 3.71
3 11
8 -0.18-1.66 0.90
X14
4
a2
b2
1 10 5.7 3.23
5.5
5.38 3.71
2 12
10 0.51-1.03 1.02
X15
5
a1
b3
1 10 7.1 0.88
7.0
7.12 1.48
68
2 -0.16-1.81 0.28
X16
6
a2
b3
1 10 13.2 1.69
13.0
13.25 2.97 11 15
4 -0.03-1.85 0.53>
> (tAC <- describeBy(d4$Y, list(d4$A, d4$C), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
c1
1 15 8.13 1.64
8
8.08 1.48
6 11
5 0.34-1.04 0.42
X12
2
a2
c1
1 15 6.53 5.05
4
6.23 2.97
2 15
13 0.57-1.50 1.31
X13
3
a1
c2
1 15 6.73 1.71
6
6.77 1.48
3 10
7 -0.09-0.25 0.44
X14
4
a2
c2
1 15 8.47 4.32
7
8.38 4.45
3 15
12 0.25-1.67 1.12>
> (tBC <- describeBy(d4$Y, list(d4$B, d4$C), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
b1
c1
1 10 5.3 2.79
5.0
5.25 4.45
2
9
7 0.05-1.94 0.88
X12
2
b2
c1
1 10 6.6 3.66
7.0
6.62 5.19
2 11
9 -0.07-1.87 1.16
X13
3
b3
c1
1 10 10.1 3.35
9.5
10.00 3.71
6 15
9 0.27-1.66 1.06
X14
4
b1
c2
1 10 5.8 1.99
6.0
5.75 2.97
39
6 0.09-1.56 0.63
X15
5
b2
c2
1 10 6.8 2.70
6.0
6.62 1.48
3 12
9 0.59-0.95 0.85
X16
6
b3
c2
1 10 10.2 3.61
9.5
10.12 5.19
6 15
9 0.13-1.85 1.14>
> (tA <- describeBy(d4$Y, list(d4$A), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
1 30 7.43 1.79
7.5
7.38 2.22
3 11
8 0.05-0.14 0.33
X122
a2
1 30 7.50 4.73
6.0
7.25 5.19
2 15
13 0.35-1.52 0.86>
> (tB <- describeBy(d4$Y, list(d4$B), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
b1
1 20 5.55 2.37
6.0
5.56 2.97
29
7 -0.03-1.57 0.53
X122
b2
1 20 6.70 3.13
6.0
6.69 4.45
2 12
10 0.11-1.34 0.70
X13
3
b3
1 20 10.15 3.39
9.5
10.06 3.71
6 15
9 0.22-1.62 0.76>
> (tC <- describeBy(d4$Y, list(d4$C), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
c1
1 30 7.33 3.78
8.0
7.17 4.45
2 15
13 0.22-0.88 0.69
X122
c2
1 30 7.60 3.35
6.5
7.29 2.22
3 15
12 0.77-0.40 0.61>
> (tall <- describe(d4$Y))vars n mean
sd median trimmed mad min max range skew kurtosisseX1
1 60 7.47 3.54
7
7.25 2.97
2 15
13 0.44-0.55 0.46>

226

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 分散分析> #aovを使う方法> result.aov <- aov(Y ~ A*B*C + Error(id + id:A:B + id:A:B:C), data=d4)
警告メッセージ:aov(Y ~ A * B * C + Error(id:A:B + id:A:B:C), data = d4) で:Error() モデルは特異です> summary(result.aov)Error: id
Df Sum Sq Mean Sq F value
Pr(>F)
A
1
0.07
0.07
0.022
0.882
B
2 229.23 114.62 38.419 3.30e-08 ***A:B
2 282.03 141.02 47.268 4.75e-09 ***Residuals 24 71.60
2.98--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:A:B:C
Df Sum Sq Mean Sq F value Pr(>F)
C
1
1.07
1.07
0.300 0.58865
A:C
1 41.67
41.67 11.737 0.00221 **
B:C
2
0.43
0.22
0.061 0.94094
A:B:C
2 29.63
14.82
4.174 0.02783 *Residuals 24 85.20
3.55--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>>> # Anovaを使う方法> library(car)> d1$A <- as.factor(d1$A)> d1$B <- as.factor(d1$B)> fac.c <- factor(c("c1","c2"))> youin <- data.frame(fac.c)> mod.1 <- lm(cbind(c1,c2)~A*B,data=d1)> result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.c)> summary(result.Anova, multivariate=FALSE)
Univariate Type II Repeated-Measures ANOVA Assuming Sphericity
SS num Df Error SS den Df
F
Pr(>F)(Intercept) 3345.1
1
71.6
24 1121.2514 < 2.2e-16 ***
A
0.1
1
71.6
24
0.0223 0.882418
B
229.2
2
71.6
24
38.4190 3.304e-08 ***
A:B
282.0
2
71.6
24
47.2682 4.746e-09 ***
fac.c
1.1
1
85.2
24
0.3005 0.588651
A:fac.c
41.7
1
85.2
24
11.7371 0.002212 **B:fac.c
0.4
2
85.2
24
0.0610 0.940938
A:B:fac.c
29.6
2
85.2
24
4.1737 0.027827 *--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
>
>
>
>
> #多重比較> #ボンフェロニの方法> (mc.bon.A <- pairwise.t.test(d4$Y, d4$A, p.adjust.method="bonferroni"))
Pairwise comparisons using t tests with pooled SD
data:

d4$Y and d4$A
227

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

a1
a2 0.94
P value adjustment method: bonferroni> (mc.bon.B <- pairwise.t.test(d4$Y, d4$B, p.adjust.method="bonferroni"))
Pairwise comparisons using t tests with pooled SD
data:

d4$Y and d4$B

b1
b2
b2 0.6896 b3 2.9e-05 0.0018
P value adjustment method: bonferroni> (mc.bon.C <- pairwise.t.test(d4$Y, d4$C, p.adjust.method="bonferroni", paired=TRUE))
Pairwise comparisons using paired t tests
data:

d4$Y and d4$C

c1
c2 0.66
P value adjustment method: bonferroni>>>> # 効果量> #eta_squared,omega_squared関数を使う方法> library(effectsize)>> eta_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Eta2 (partial) |95% CI---------------------------------------------------id|A |9.30e-04 | [0.00, 0.12]
id|
B |0.76 | [0.56, 0.85]
id
|
A:B |
0.80 | [0.62, 0.88]
id:A:B:C |C |0.01 | [0.00, 0.20]
id:A:B:C |A:C |0.33 | [0.06, 0.56]
id:A:B:C |B:C |5.06e-03 | [0.00, 0.07]
id:A:B:C |A:B:C |
0.26 | [0.00, 0.50]> omega_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Omega2 (partial) |95% CI-----------------------------------------------------id|A |0.00 | [0.00, 0.00]
id|
B |0.73 | [0.51, 0.84]
id
|
A:B |
0.77 | [0.58, 0.86]
id:A:B:C |C |0.00 | [0.00, 0.00]
id:A:B:C |A:C |0.19 | [0.00, 0.45]
id:A:B:C |B:C |0.00 | [0.00, 0.00]
id:A:B:C |A:B:C |
0.12 | [0.00, 0.35]>> eta_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter | Eta2 (partial) |95% CI----------------------------------------228

名古屋 大学
A
|
B
|
A:B
|
fac.c
|
A:fac.c|
B:fac.c|
A:B:fac.c |大 学院 教育発 達科 学研 究科・ 教育 学部

9.30e-04 | [0.00, 0.12]
0.76 | [0.56, 0.85]
0.80 | [0.62, 0.88]
0.01 | [0.00, 0.20]
0.33 | [0.06, 0.56]
5.06e-03 | [0.00, 0.07]
0.26 | [0.00, 0.50]> omega_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter | Omega2 (partial) |95% CI------------------------------------------A|
0.00 | [0.00, 0.00]
B|
0.73 | [0.51, 0.84]
A:B|
0.77 | [0.58, 0.86]
fac.c|
0.00 | [0.00, 0.00]
A:fac.c|
0.19 | [0.00, 0.45]
B:fac.c|
0.00 | [0.00, 0.00]
A:B:fac.c |0.12 | [0.00, 0.35]>> #EtaSq関数を使う方法> library(DescTools)> EtaSq(result.aov, type=1)
eta.sq eta.sq.part
eta.sq.genA
8.997661e-05 0.0009302326 0.0004249894
B
3.093846e-01 0.7619944598 0.5938174596
A:B
3.806460e-01 0.7975303987 0.6426889480
C
1.439626e-03 0.0123647604 0.0067567568
A:C
5.623538e-02 0.3284287966 0.2099428955
B:C
5.848479e-04 0.0050603348 0.0027559890
A:B:C 3.999460e-02 0.2580551524 0.1589486859>>>>> #平均値を比較する棒グラフの作成> d4t <- d4[d4$C=="c1",]> m4t <- tapply(d4t[,"Y"], list(d4t[,"A"], d4t[,"B"]), mean)> barplot(m4t, beside=TRUE,legend=TRUE, ylim=c(0,20), las=1, ylab="Mean", main="C=c1")> segments(0,0,10,0)>> d4t <- d4[d4$C=="c2",]> m4t <- tapply(d4t[,"Y"], list(d4t[,"A"], d4t[,"B"]), mean)> barplot(m4t, beside=TRUE,legend=TRUE, ylim=c(0,20), las=1, ylab="Mean", main="C=c2")> segments(0,0,10,0)>229

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

１つの被験者間要因と２つの被験者内要因(１Ｂ２Ｗ)
stackデータの作成
被験者内要因の水準ごとにstackデータを作成して，最後に縦に繋げる
vn.x <- c("b1c1","b1c2","b2c1","b2c2","b3c1","b3c2")
d3 <- NULL
for(i in vn.x){d2 <- d1
d2$X <- id2$Y <- d1[,i]d3 <- rbind(d3,d2)}
d3$B <- substr(d3$X,1,2)
d3$C <- substr(d3$X,3,4)
d4<- d3[,c("id","A","B","C","Y")]d4$id <- as.factor(d4$id)
d4$A <- as.factor(d4$A)
d4$B <- as.factor(d4$B)
d4$C <- as.factor(d4$C)
head(d4)
データフレーム名 ：d4
被験者ID
：id
被験者間要因変数 ：A
被験者内要因変数1：B
被験者内要因変数2：C
従属変数：Y【重要！！】
被験者idも含め，独立変数をfactor型と言われる形式にしておかなければならない関数が多いので，まずこれをやっておく．
factor型にしていないと，間違った分散分析をした結果を出力してしまう．
間違っているかどうかは，独立変数の自由度Dfの値が「水準数-1」になっているか否かなどでわかる．

分散分析
aovを使う方法
result.aov <- aov(Y ~ A*B*C + Error(id + id:A + id:A:B + id:A:C + id:A:B:C), data=d4)
summary(result.aov)「球面性の仮定」が満たされることを前提としている．
Anovaを使う方法
データフレーム名 ：d1
被験者ID
：id
被験者間要因変数 ：A
被験者内要因名1 ：fac.b <- factor(c("b1","b1","b2","b2","b3","b3"))
被験者内要因名2 ：fac.c <- factor(c("c1","c2","c1","c2","c1","c2"))
全被験者内要因：youin従属変数：Ylibrary(car)d1$A <- as.factor(d1$A)
fac.b <- factor(c("b1","b1","b2","b2","b3","b3"))
fac.c <- factor(c("c1","c2","c1","c2","c1","c2"))
youin <- data.frame(fac.b, fac.c)mod.1 <- lm(cbind(b1c1,b1c2,b2c1,b2c2,b3c1,b3c2)~A,data=d1)
result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.b*fac.c)summary(result.Anova, multivariate=FALSE)「球面性の仮定」の検討をして，修正した結果も表示する．
あらかじめcarパッケージをインストールしておく必要がある．
multivariate=TRUE としておくと，多変量分散分析の結果も表示してくれる．

230

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多重比較
被験者間要因pairwise.t.test(d1$Y, d1$A, p.adjust.method="bonferroni")
被験者内要因pairwise.t.test(d1$Y, d1$C, p.adjust.method="bonferroni", paired=TRUE)
p.adjusted.method: “holm”,“hochberg”,“hommel”,“bonferroni”,“BH”,“BY”,“fdr”

効果量effectsizeパッケージのeta_squared, omega_squared関数を使う方法
library(effectsize)
eta_squared(分散分析オブジェクト, alternative="two.sided")omega_squared(分散分析オブジェクト, alternative="two.sided")
あらかじめeffectsizeパッケージをインストールしておく必要がある．
aov, Anova関数で分散分析を実行した結果オブジェクトをeta_squared, omega_squaredに入れる．
効果量の信頼区間の推定する際，alternative="two.sided" を指定しておくと，下限と上限を推定する信頼区間となる。（指定しない場合，上限は1.00となる。）
DescToolsパッケージのEtaSq関数を使う方法
library(DescTools)
EtaSq(aovオブジェクト, type=1)
各効果について，η2乗，偏η2乗，一般化η2乗の値を計算する．
あらかじめDescToolsパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqに入れる．
typeオプションでtype=1と指定する。（デフォルトはtype=2）> setwd("d:\\")> d1 <- read.table("1B2W平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id A b1c1 b1c2 b2c1 b2c2 b3c1 b3c2
1 1 a18961077
2 2 a1669
686
3 3 a18810
578
4 4 a19611
386
5 5 a187
11
66
8
6 6 a2
2
4
4
6
11
15
>
>
> # stackデータの作成> vn.x <- c("b1c1","b1c2","b2c1","b2c2","b3c1","b3c2")> d3 <- NULL
> for(i in vn.x){+ d2 <- d1+ d2$X <- i
+ d2$Y <- d1[,i]+ d3 <- rbind(d3,d2)+ }> d3$B <- substr(d3$X,1,2)> d3$C <- substr(d3$X,3,4)> d4<- d3[,c("id","A","B","C","Y")]> d4$id <- as.factor(d4$id)> d4$A <- as.factor(d4$A)> d4$B <- as.factor(d4$B)> d4$C <- as.factor(d4$C)> head(d4)id A B

C Y
231

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

1 1 a1 b1 c1 8
2 2 a1 b1 c1 6
3 3 a1 b1 c1 8
4 4 a1 b1 c1 95 5 a1 b1 c1 86 6 a2 b1 c1 2>>>>
> #各群の人数・平均値・標準偏差> library(psych)> (tABC <- describeBy(d4$Y, list(d4$A, d4$B, d4$C), mat=TRUE, digits=2))
item group1 group2 group3 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
b1
c1
1 5 7.8 1.108
7.8 0.00
6
9
3 -0.62-1.25 0.49
X12
2
a2
b1
c1
1 5 2.8 0.84
3
2.8 1.48
2
4
2 0.25-1.82 0.37
X13
3
a1
b2
c1
1 5 9.4 2.07
10
9.4 1.48
6 11
5 -0.69-1.41 0.93
X14
4
a2
b2
c1
1 5 3.8 2.49
3
3.8 1.48
28
6 0.80-1.27 1.11
X15
5
a1
b3
c1
1 5 7.2 0.84
7
7.2 1.48
6
8
2 -0.25-1.82 0.37
X16
6
a2
b3
c1
1 5 13.0 1.87
12
13.0 1.48 11 15
4 0.18-2.18 0.84
X17
7
a1
b1
c2
1 5 7.2 1.30
7
7.2 1.48
6
9
3 0.26-1.96 0.58
X18
8
a2
b1
c2
1 5 4.4 1.52
4
4.4 0.00
37
4 0.84-1.12 0.68
X19
9
a1
b2
c2
1 5 6.0 2.55
6
6.0 1.48
3 10
7 0.43-1.40 1.14
X110
10
a2
b2
c2
1 5 7.6 2.88
6
7.6 1.48
5 12
7 0.52-1.73 1.29
X111
11
a1
b3
c2
1 5 7.0 1.00
7
7.0 1.48
68
2 0.00-2.20 0.45
X112
12
a2
b3
c2
1 5 13.4 1.67
13
13.4 2.97 11 15
4 -0.25-1.82 0.75>
> (tAB <- describeBy(d4$Y, list(d4$A, d4$B), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
b1
1 10 7.5 1.18
8.0
7.50 1.48
6
9
3 -0.18-1.67 0.37
X12
2
a2
b1
1 10 3.6 1.43
3.5
3.38 0.74
27
5 1.050.52 0.45
X13
3
a1
b2
1 10 7.7 2.83
7.5
7.88 3.71
3 11
8 -0.18-1.66 0.90
X14
4
a2
b2
1 10 5.7 3.23
5.5
5.38 3.71
2 12
10 0.51-1.03 1.02
X15
5
a1
b3
1 10 7.1 0.88
7.0
7.12 1.48
68
2 -0.16-1.81 0.28
X16
6
a2
b3
1 10 13.2 1.69
13.0
13.25 2.97 11 15
4 -0.03-1.85 0.53>
> (tAC <- describeBy(d4$Y, list(d4$A, d4$C), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
c1
1 15 8.13 1.64
8
8.08 1.48
6 11
5 0.34-1.04 0.42
X12
2
a2
c1
1 15 6.53 5.05
4
6.23 2.97
2 15
13 0.57-1.50 1.31
X13
3
a1
c2
1 15 6.73 1.71
6
6.77 1.48
3 10
7 -0.09-0.25 0.44
X14
4
a2
c2
1 15 8.47 4.32
7
8.38 4.45
3 15
12 0.25-1.67 1.12>
> (tBC <- describeBy(d4$Y, list(d4$B, d4$C), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
b1
c1
1 10 5.3 2.79
5.0
5.25 4.45
2
9
7 0.05-1.94 0.88
X12
2
b2
c1
1 10 6.6 3.66
7.0
6.62 5.19
2 11
9 -0.07-1.87 1.16
X13
3
b3
c1
1 10 10.1 3.35
9.5
10.00 3.71
6 15
9 0.27-1.66 1.06
X14
4
b1
c2
1 10 5.8 1.99
6.0
5.75 2.97
39
6 0.09-1.56 0.63
X15
5
b2
c2
1 10 6.8 2.70
6.0
6.62 1.48
3 12
9 0.59-0.95 0.85
X16
6
b3
c2
1 10 10.2 3.61
9.5
10.12 5.19
6 15
9 0.13-1.85 1.14>
> (tA <- describeBy(d4$Y, list(d4$A), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
1 30 7.43 1.79
7.5
7.38 2.22
3 11
8 0.05-0.14 0.33
X122
a2
1 30 7.50 4.73
6.0
7.25 5.19
2 15
13 0.35-1.52 0.86>
> (tB <- describeBy(d4$Y, list(d4$B), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
b1
1 20 5.55 2.37
6.0
5.56 2.97
29
7 -0.03-1.57 0.53
X122
b2
1 20 6.70 3.13
6.0
6.69 4.45
2 12
10 0.11-1.34 0.70
X13
3
b3
1 20 10.15 3.39
9.5
10.06 3.71
6 15
9 0.22-1.62 0.76>
> (tC <- describeBy(d4$Y, list(d4$C), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
c1
1 30 7.33 3.78
8.0
7.17 4.45
2 15
13 0.22-0.88 0.69
232名古屋 大学
X12
>

2

c2

1 30 7.60 3.35

6.5

7.29 2.22

3

大 学院 教育発 達科 学研 究科・ 教育 学部
15

12 0.77-0.40 0.61

> (tall <- describe(d4$Y))vars n mean
sd median trimmed mad min max range skew kurtosisseX1
1 60 7.47 3.54
7
7.25 2.97
2 15
13 0.44-0.55 0.46

> # 分散分析> #aovを使う方法> result.aov <- aov(Y ~ A*B*C + Error(id + id:A + id:A:B + id:A:C + id:A:B:C), data=d4)
警告メッセージ:aov(Y ~ A * B * C + Error(id:A + id:A:B + id:A:C + id:A:B:C), で:Error() モデルは特異です> summary(result.aov)Error: id
A
Residuals

Df Sum Sq Mean Sq F value Pr(>F)
1 0.067 0.0667
0.024 0.882
8 22.533 2.8167

Error: id:A:B
Df Sum Sq Mean Sq F value
Pr(>F)
B
2 229.23 114.62
37.38 9.34e-07 ***A:B
2 282.03 141.02
45.98 2.33e-07 ***Residuals 16 49.07
3.07--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:A:C
Df Sum Sq Mean Sq F value Pr(>F)
C
1
1.07
1.07
0.199 0.6675
A:C
1 41.6741.67
7.764 0.0237 *Residuals 8 42.93
5.37--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:A:B:C
Df Sum Sq Mean Sq F value Pr(>F)
B:C
2
0.43
0.217
0.082 0.9216
A:B:C
2 29.63 14.817
5.609 0.0143 *Residuals 16 42.27
2.642--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>>> # Anovaを使う方法> library(car)> d1$A <- as.factor(d1$A)> fac.b <- factor(c("b1","b1","b2","b2","b3","b3"))> fac.c <- factor(c("c1","c2","c1","c2","c1","c2"))> youin <- data.frame(fac.b, fac.c)> mod.1 <- lm(cbind(b1c1,b1c2,b2c1,b2c2,b3c1,b3c2)~A,data=d1)> result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.b*fac.c)> summary(result.Anova, multivariate=FALSE)
Univariate Type II Repeated-Measures ANOVA Assuming Sphericity(Intercept)
A
fac.b
A:fac.bfac.c
A:fac.cfac.b:fac.c

SS num Df Error SS den Df
F
Pr(>F)
3345.1
1
22.5338 1187.5976 5.496e-10 ***0.1
122.5338
0.02370.88154229.2
249.0671637.3750 9.337e-07 ***282.0
249.0671645.9837 2.326e-07 ***1.1
142.9338
0.19880.6675441.7
142.93387.76400.02369 *0.4
242.267160.08200.92164233

名古屋 大学
A:fac.b:fac.c--Signif. codes:

29.6

2

42.26716

5.6088

大 学院 教育発 達科 学研 究科・ 教育 学部

0.01426 *0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Mauchly Tests for Sphericity
fac.b
A:fac.bfac.b:fac.c
A:fac.b:fac.c

Test statistic p-value
0.52234 0.102998
0.52234 0.102998
0.47128 0.071856
0.47128 0.071856

Greenhouse-Geisser and Huynh-Feldt Corrections
for Departure from Sphericity
GG eps Pr(>F[GG])fac.b0.67674 3.718e-05 ***A:fac.b0.67674 1.439e-05 ***fac.b:fac.c
0.654140.84339
A:fac.b:fac.c 0.65414
0.03164 *--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
HF epsPr(>F[HF])fac.b
0.7659206 1.339476e-05
A:fac.b0.7659206 4.589669e-06
fac.b:fac.c
0.7303445 8.662260e-01
A:fac.b:fac.c 0.7303445 2.650360e-02>> #多重比較> #ボンフェロニの方法> (mc.bon.A <- pairwise.t.test(d4$Y, d4$A, p.adjust.method="bonferroni"))
Pairwise comparisons using t tests with pooled SD
data:

d4$Y and d4$A

a1
a2 0.94
P value adjustment method: bonferroni> (mc.bon.B <- pairwise.t.test(d4$Y, d4$B, p.adjust.method="bonferroni", paired=TRUE))
Pairwise comparisons using paired t tests
data:

d4$Y and d4$B

b1
b2
b2 0.2106 b3 0.0034 0.0258
P value adjustment method: bonferroni> (mc.bon.C <- pairwise.t.test(d4$Y, d4$C, p.adjust.method="bonferroni", paired=TRUE))
Pairwise comparisons using paired t tests
data:

d4$Y and d4$C

c1
c2 0.66
P value adjustment method: bonferroni>
234名古屋 大学>> # 効果量> #eta_squared,omega_squared関数を使う方法> library(effectsize)>> eta_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Eta2 (partial) |95% CI---------------------------------------------------id|A |2.95e-03 | [0.00, 0.26]
id:A:B|B |0.82 | [0.61, 0.90]
id:A:B|
A:B |0.85 | [0.67, 0.92]
id:A:C|C |0.02 | [0.00, 0.41]
id:A:C|
A:C |0.49 | [0.00, 0.77]
id:A:B:C |B:C |0.01 | [0.00, 0.13]
id:A:B:C |A:B:C |
0.41 | [0.03, 0.65]> omega_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Omega2 (partial) |95% CI-----------------------------------------------------id|A |0.00 | [0.00, 0.00]
id:A:B|B |0.73 | [0.43, 0.85]
id:A:B|
A:B |0.77 | [0.51, 0.87]
id:A:C|C |0.00 | [0.00, 0.00]
id:A:C|
A:C |0.33 | [0.00, 0.68]
id:A:B:C |B:C |0.00 | [0.00, 0.00]
id:A:B:C |A:B:C |
0.25 | [0.00, 0.53]>> eta_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter| Eta2 (partial) |95% CI--------------------------------------------A|
2.95e-03 | [0.00, 0.28]
fac.b|
0.82 | [0.61, 0.90]
A:fac.b|0.85 | [0.67, 0.92]
fac.c|
0.02 | [0.00, 0.41]
A:fac.c|
0.49 | [0.00, 0.77]
fac.b:fac.c|
0.01 | [0.00, 0.13]
A:fac.b:fac.c |0.41 | [0.03, 0.65]> omega_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type II)
Parameter| Omega2 (partial) |95% CI----------------------------------------------A|
0.00 | [0.00, 0.00]
fac.b|
0.73 | [0.43, 0.85]
A:fac.b|0.77 | [0.51, 0.87]
fac.c|
0.00 | [0.00, 0.00]
A:fac.c|
0.33 | [0.00, 0.68]
fac.b:fac.c|
0.00 | [0.00, 0.00]
A:fac.b:fac.c |0.25 | [0.00, 0.53]
>
>

235

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #EtaSq関数を使う方法> library(DescTools)> EtaSq(result.aov, type=1)
eta.sq eta.sq.part
eta.sq.genA
8.997661e-05 0.002949853 0.0004249894
B
3.093846e-01 0.823691460 0.5938174596
A:B
3.806460e-01 0.851807108 0.6426889480
C
1.439626e-03 0.024242424 0.0067567568
A:C
5.623538e-02 0.492513790 0.2099428955
B:C
5.848479e-04 0.010148322 0.0027559890
A:B:C 3.999460e-02 0.412146500 0.1589486859>> #平均値を比較する棒グラフの作成> d4t <- d4[d4$C=="c1",]> m4t <- tapply(d4t[,"Y"], list(d4t[,"A"], d4t[,"B"]), mean)> barplot(m4t, beside=TRUE,legend=TRUE, ylim=c(0,20), las=1, ylab="Mean", main="C=c1")> segments(0,0,10,0)>> d4t <- d4[d4$C=="c2",]> m4t <- tapply(d4t[,"Y"], list(d4t[,"A"], d4t[,"B"]), mean)> barplot(m4t, beside=TRUE,legend=TRUE, ylim=c(0,20), las=1, ylab="Mean", main="C=c2")> segments(0,0,10,0)236

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

３つの被験者内要因(３Ｗ)
stackデータの作成
d3 <- stack(d2)d3$A <- substr(d3$ind,1,2)
d3$B <- substr(d3$ind,3,4)
d3$C <- substr(d3$ind,5,6)
d3$id <- d1$id
d4 <- d3[,c("id","A","B","C","values")]colnames(d4) <- c("id","A","B","C","Y")
d4$id <- as.factor(d4$id)
d4$A <- as.factor(d4$A)
d4$B <- as.factor(d4$B)
d4$C <- as.factor(d4$C)
head(d4)
データフレーム名：d4
被験者ID
：id
被験者内要因変数1：A
被験者内要因変数2：B
被験者内要因変数3：C
従属変数：Y【重要！！】
被験者idも含め，独立変数をfactor型と言われる形式にしておかなければならない関数が多いので，まずこれをやっておく．
factor型にしていないと，間違った分散分析をした結果を出力してしまう．
間違っているかどうかは，独立変数の自由度Dfの値が「水準数-1」になっているか否かなどでわかる．

分散分析
aovを使う方法
result.aov <- aov(Y ~ A*B*C + Error(id + id:A + id:B + id:C
+ id:A:B + id:A:C + id:B:C+ id:A:B:C), data=d4)
summary(result.aov)「球面性の仮定」が満たされることを前提としている．
Anovaを使う方法
データフレーム名：d1
被験者ID
：id
被験者内要因名1：fac.a <- factor(c("a1","a1","a1","a1","a1","a1","a2","a2","a2","a2","a2","a2"))
被験者内要因名2：fac.b <- factor(c("b1","b1","b2","b2","b3","b3","b1","b1","b2","b2","b3","b3"))
被験者内要因名3：fac.c <- factor(c("c1","c2","c1","c2","c1","c2","c1","c2","c1","c2","c1","c2"))
全被験者内要因 ：youin
従属変数：Y
library(car)fac.a <- factor(c("a1","a1","a1","a1","a1","a1","a2","a2","a2","a2","a2","a2"))
fac.b <- factor(c("b1","b1","b2","b2","b3","b3","b1","b1","b2","b2","b3","b3"))
fac.c <- factor(c("c1","c2","c1","c2","c1","c2","c1","c2","c1","c2","c1","c2"))
youin <- data.frame(fac.a, fac.b, fac.c)mod.1 <- lm(cbind(a1b1c1,a1b1c2,a1b2c1,a1b2c2,a1b3c1,a1b3c2,
a2b1c1,a2b1c2,a2b2c1,a2b2c2,a2b3c1,a2b3c2)~1,data=d1)
result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.a*fac.b*fac.c)summary(result.Anova, multivariate=FALSE)「球面性の仮定」の検討をして，修正した結果も表示する．
あらかじめcarパッケージをインストールしておく必要がある．
multivariate=TRUE としておくと，多変量分散分析の結果も表示してくれる．

多重比較
被験者内要因pairwise.t.test(d1$Y, d1$C, p.adjust.method="bonferroni", paired=TRUE)
p.adjusted.method: “holm”,“hochberg”,“hommel”,“bonferroni”,“BH”,“BY”,“fdr”
237

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

効果量
effectsizeパッケージのeta_squared, omega_squared関数を使う方法
library(effectsize)
eta_squared(分散分析オブジェクト, alternative="two.sided")omega_squared(分散分析オブジェクト, alternative="two.sided")
あらかじめeffectsizeパッケージをインストールしておく必要がある．
aov, Anova関数で分散分析を実行した結果オブジェクトをeta_squared, omega_squaredに入れる．
効果量の信頼区間の推定する際，alternative="two.sided" を指定しておくと，下限と上限を推定する信頼区間となる。（指定しない場合，上限は1.00となる。）
DescToolsパッケージのEtaSq関数を使う方法
library(DescTools)
EtaSq(aovオブジェクト, type=1)
各効果について，η2乗，偏η2乗，一般化η2乗の値を計算する．
あらかじめDescToolsパッケージをインストールしておく必要がある．
aov関数で分散分析を実行した結果オブジェクトをetaSqに入れる．
typeオプションでtype=1と指定する。（デフォルトはtype=2）> setwd("d:\\")> d1 <- read.table("3W平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d2 <- d1[-1]> head(d2)a1b1c1 a1b1c2 a1b2c1 a1b2c2 a1b3c1 a1b3c2 a2b1c1 a2b1c2 a2b2c1 a2b2c2
1
8
9
6
10
7
7
2
4
4
6
2
6
6
9
6
8
6
4
4
3
5
3
8
8
10
5
7
8
3
3
2
6
4
9
6
11
3
8
6
2
7
2
9
5
8
7
11
6
6
8
3
4
8
12
a2b3c1 a2b3c2
1
11
15
2
15
15
3
12
13
4
12
13
5
15
11
>
>
> #stackデータの作成> d3 <- stack(d2)> d3$A <- substr(d3$ind,1,2)> d3$B <- substr(d3$ind,3,4)> d3$C <- substr(d3$ind,5,6)> d3$id <- d1$id> d4 <- d3[,c("id","A","B","C","values")]> colnames(d4) <- c("id","A","B","C","Y")> d4$id <- as.factor(d4$id)> d4$A <- as.factor(d4$A)> d4$B <- as.factor(d4$B)> d4$C <- as.factor(d4$C)> head(d4)id A B C Y
1 1 a1 b1 c1 8
2 2 a1 b1 c1 6
3 3 a1 b1 c1 8
4 4 a1 b1 c1 95 5 a1 b1 c1 8
6 1 a1 b1 c2 9
>
>
>
238

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #各群の人数・平均値・標準偏差> library(psych)> (tABC <- describeBy(d4$Y, list(d4$A, d4$B, d4$C), mat=TRUE, digits=2))
item group1 group2 group3 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
b1
c1
1 5 7.8 1.108
7.8 0.00
6
9
3 -0.62-1.25 0.49
X12
2
a2
b1
c1
1 5 2.8 0.84
3
2.8 1.48
2
4
2 0.25-1.82 0.37
X13
3
a1
b2
c1
1 5 9.4 2.07
10
9.4 1.48
6 11
5 -0.69-1.41 0.93
X14
4
a2
b2
c1
1 5 3.8 2.49
3
3.8 1.48
28
6 0.80-1.27 1.11
X15
5
a1
b3
c1
1 5 7.2 0.84
7
7.2 1.48
6
8
2 -0.25-1.82 0.37
X16
6
a2
b3
c1
1 5 13.0 1.87
12
13.0 1.48 11 15
4 0.18-2.18 0.84
X17
7
a1
b1
c2
1 5 7.2 1.30
7
7.2 1.48
6
9
3 0.26-1.96 0.58
X18
8
a2
b1
c2
1 5 4.4 1.52
4
4.4 0.00
37
4 0.84-1.12 0.68
X19
9
a1
b2
c2
1 5 6.0 2.55
6
6.0 1.48
3 10
7 0.43-1.40 1.14
X110
10
a2
b2
c2
1 5 7.6 2.88
6
7.6 1.48
5 12
7 0.52-1.73 1.29
X111
11
a1
b3
c2
1 5 7.0 1.00
7
7.0 1.48
68
2 0.00-2.20 0.45
X112
12
a2
b3
c2
1 5 13.4 1.67
13
13.4 2.97 11 15
4 -0.25-1.82 0.75>
> (tAB <- describeBy(d4$Y, list(d4$A, d4$B), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
b1
1 10 7.5 1.18
8.0
7.50 1.48
6
9
3 -0.18-1.67 0.37
X12
2
a2
b1
1 10 3.6 1.43
3.5
3.38 0.74
27
5 1.050.52 0.45
X13
3
a1
b2
1 10 7.7 2.83
7.5
7.88 3.71
3 11
8 -0.18-1.66 0.90
X14
4
a2
b2
1 10 5.7 3.23
5.5
5.38 3.71
2 12
10 0.51-1.03 1.02
X15
5
a1
b3
1 10 7.1 0.88
7.0
7.12 1.48
68
2 -0.16-1.81 0.28
X16
6
a2
b3
1 10 13.2 1.69
13.0
13.25 2.97 11 15
4 -0.03-1.85 0.53>
> (tAC <- describeBy(d4$Y, list(d4$A, d4$C), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
c1
1 15 8.13 1.64
8
8.08 1.48
6 11
5 0.34-1.04 0.42
X12
2
a2
c1
1 15 6.53 5.05
4
6.23 2.97
2 15
13 0.57-1.50 1.31
X13
3
a1
c2
1 15 6.73 1.71
6
6.77 1.48
3 10
7 -0.09-0.25 0.44
X14
4
a2
c2
1 15 8.47 4.32
7
8.38 4.45
3 15
12 0.25-1.67 1.12>
> (tBC <- describeBy(d4$Y, list(d4$B, d4$C), mat=TRUE, digits=2))
item group1 group2 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
b1
c1
1 10 5.3 2.79
5.0
5.25 4.45
2
9
7 0.05-1.94 0.88
X12
2
b2
c1
1 10 6.6 3.66
7.0
6.62 5.19
2 11
9 -0.07-1.87 1.16
X13
3
b3
c1
1 10 10.1 3.35
9.5
10.00 3.71
6 15
9 0.27-1.66 1.06
X14
4
b1
c2
1 10 5.8 1.99
6.0
5.75 2.97
39
6 0.09-1.56 0.63
X15
5
b2
c2
1 10 6.8 2.70
6.0
6.62 1.48
3 12
9 0.59-0.95 0.85
X16
6
b3
c2
1 10 10.2 3.61
9.5
10.12 5.19
6 15
9 0.13-1.85 1.14>
> (tA <- describeBy(d4$Y, list(d4$A), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
a1
1 30 7.43 1.79
7.5
7.38 2.22
3 11
8 0.05-0.14 0.33
X122
a2
1 30 7.50 4.73
6.0
7.25 5.19
2 15
13 0.35-1.52 0.86>
> (tB <- describeBy(d4$Y, list(d4$B), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
b1
1 20 5.55 2.37
6.0
5.56 2.97
29
7 -0.03-1.57 0.53
X122
b2
1 20 6.70 3.13
6.0
6.69 4.45
2 12
10 0.11-1.34 0.70
X13
3
b3
1 20 10.15 3.39
9.5
10.06 3.71
6 15
9 0.22-1.62 0.76>
> (tC <- describeBy(d4$Y, list(d4$C), mat=TRUE, digits=2))
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
se
X11
1
c1
1 30 7.33 3.78
8.0
7.17 4.45
2 15
13 0.22-0.88 0.69
X122
c2
1 30 7.60 3.35
6.5
7.29 2.22
3 15
12 0.77-0.40 0.61>
> (tall <- describe(d4$Y))vars n mean
sd median trimmed mad min max range skew kurtosisseX1
1 60 7.47 3.54
7
7.25 2.97
2 15
13 0.44-0.55 0.46>

239

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> # 分散分析> #aovを使う方法> result.aov <- aov(Y ~ A*B*C + Error(id + id:A + id:B + id:C+
+ id:A:B + id:A:C + id:B:C++ id:A:B:C), data=d4)> summary(result.aov)Error: id
Residuals

Df Sum Sq Mean Sq F value Pr(>F)
4 9.933
2.483

Error: id:A
Df Sum Sq Mean Sq F value Pr(>F)
A
1 0.067 0.0667
0.021 0.891
Residuals 4 12.600 3.1500
Error: id:B
Df Sum Sq Mean Sq F value
Pr(>F)
B
2 229.23 114.62
30.3 0.000185 ***Residuals 8 30.27
3.78--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:C
Df Sum Sq Mean Sq F value Pr(>F)
C
1 1.067
1.067
0.292 0.617
Residuals 4 14.600
3.650
Error: id:A:B
Df Sum Sq Mean Sq F value
Pr(>F)
A:B
2 282.0 141.02
60.01 1.53e-05 ***Residuals 8
18.8
2.35
--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:A:C
Df Sum Sq Mean Sq F value Pr(>F)
A:C
1 41.6741.67
5.882 0.0723 .
Residuals 4 28.33
7.08--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:B:C
Df Sum Sq Mean Sq F value Pr(>F)
B:C
2 0.433 0.2167
0.394 0.687
Residuals 8 4.400 0.5500
Error: id:A:B:C
Df Sum Sq Mean Sq F value Pr(>F)
A:B:C
2 29.63 14.817
3.13 0.099 .
Residuals 8 37.87
4.733--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>>> # Anovaを使う方法> library(car)> fac.a <- factor(c("a1","a1","a1","a1","a1","a1","a2","a2","a2","a2","a2","a2"))> fac.b <- factor(c("b1","b1","b2","b2","b3","b3","b1","b1","b2","b2","b3","b3"))> fac.c <- factor(c("c1","c2","c1","c2","c1","c2","c1","c2","c1","c2","c1","c2"))> youin <- data.frame(fac.a, fac.b, fac.c)> mod.1 <- lm(cbind(a1b1c1,a1b1c2,a1b2c1,a1b2c2,a1b3c1,a1b3c2,+
a2b1c1,a2b1c2,a2b2c1,a2b2c2,a2b3c1,a2b3c2)~1,data=d1)> result.Anova <- Anova(mod.1, idata=youin, idesign=~fac.a*fac.b*fac.c)240名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Note: model has only an intercept; equivalent type-III tests substituted.
> summary(result.Anova, multivariate=FALSE)
Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
SS num Df Error SS den Df
F
Pr(>F)(Intercept)
3345.11
9.933
4 1347.0067 3.291e-06 ***
fac.a
0.1
1
12.6004
0.0212 0.8913695
fac.b
229.2
2
30.267830.2952 0.0001851 ***
fac.c
1.1
1
14.6004
0.2922 0.6174859
fac.a:fac.b282.0
218.800860.0071 1.525e-05 ***fac.a:fac.c41.7
128.33345.8824 0.0723430 .
fac.b:fac.c
0.4
2
4.400
8
0.3939 0.6867896
fac.a:fac.b:fac.c
29.6
2
37.86783.1303 0.0990406 .
--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Mauchly Tests for Sphericity
fac.b
fac.a:fac.b
fac.b:fac.c
fac.a:fac.b:fac.c

Test statistic p-value
0.57164 0.43220
0.41931 0.27152
0.97452 0.96202
0.31090 0.17336

Greenhouse-Geisser and Huynh-Feldt Corrections
for Departure from Sphericity
GG eps Pr(>F[GG])fac.b0.70011 0.0013655 **fac.a:fac.b
0.63263 0.0004371 ***fac.b:fac.c
0.97515 0.6822543
fac.a:fac.b:fac.c 0.59203 0.1400839--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
HF epsPr(>F[HF])fac.b
0.9618198 0.0002382353
fac.a:fac.b
0.7909991 0.0001021096
fac.b:fac.c
1.8908912 0.6867896092
fac.a:fac.b:fac.c 0.6960966 0.1281291458
警告メッセージ:
summary.Anova.mlm(result.Anova, multivariate = FALSE) で:
HF eps > 1 treated as 1>

> #多重比較> #ボンフェロニの方法> (mc.bon.A <- pairwise.t.test(d4$Y, d4$A, p.adjust.method="bonferroni", paired=TRUE))
Pairwise comparisons using paired t tests
data:

d4$Y and d4$A

a1
a2 0.95
P value adjustment method: bonferroni

241名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> (mc.bon.B <- pairwise.t.test(d4$Y, d4$B, p.adjust.method="bonferroni", paired=TRUE))
Pairwise comparisons using paired t tests
data:

d4$Y and d4$B

b1
b2
b2 0.2106 b3 0.0034 0.0258
P value adjustment method: bonferroni> (mc.bon.C <- pairwise.t.test(d4$Y, d4$C, p.adjust.method="bonferroni", paired=TRUE))
Pairwise comparisons using paired t tests
data:

d4$Y and d4$C

c1
c2 0.66
P value adjustment method: bonferroni> # 効果量> #eta_squared,omega_squared関数を使う方法> library(effectsize)>> eta_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Eta2 (partial) |95% CI---------------------------------------------------id:A|A |5.26e-03 | [0.00, 0.43]
id:B
|
B |
0.88 | [0.59, 0.95]
id:C
|
C |
0.07 | [0.00, 0.60]
id:A:B|
A:B |0.94 | [0.77, 0.97]
id:A:C|
A:C |0.60 | [0.00, 0.86]
id:B:C|
B:C |0.09 | [0.00, 0.44]
id:A:B:C |A:B:C |
0.44 | [0.00, 0.73]> omega_squared(result.aov, alternative="two.sided")# Effect Size for ANOVA (Type I)
Group| Parameter | Omega2 (partial) |95% CI-----------------------------------------------------id:A|A |0.00 | [0.00, 0.00]
id:B
|
B |
0.82 | [0.39, 0.92]
id:C
|
C |
0.00 | [0.00, 0.00]
id:A:B|
A:B |0.89 | [0.60, 0.95]
id:A:C|
A:C |0.42 | [0.00, 0.79]
id:B:C|
B:C |0.00 | [0.00, 0.00]
id:A:B:C |A:B:C |
0.25 | [0.00, 0.61]>> eta_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type III)
Parameter| Eta2 (partial) |95% CI------------------------------------------------fac.a|
5.26e-03 | [0.00, 0.43]
fac.a:fac.c|
0.60 | [0.00, 0.86]
fac.c|
0.07 | [0.00, 0.60]
fac.b|
0.88 | [0.59, 0.95]
fac.a:fac.b|
0.94 | [0.77, 0.97]
fac.b:fac.c|
0.09 | [0.00, 0.44]
fac.a:fac.b:fac.c |0.44 | [0.00, 0.73]
242

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> omega_squared(result.Anova, alternative="two.sided")# Effect Size for ANOVA (Type III)
Parameter| Omega2 (partial) |95% CI--------------------------------------------------fac.a|
0.00 | [0.00, 0.00]
fac.a:fac.c|
0.42 | [0.00, 0.79]
fac.c|
0.00 | [0.00, 0.00]
fac.b|
0.82 | [0.39, 0.92]
fac.a:fac.b|
0.89 | [0.60, 0.95]
fac.b:fac.c|
0.00 | [0.00, 0.00]
fac.a:fac.b:fac.c |0.25 | [0.00, 0.61]>>> #EtaSq関数を使う方法> library(DescTools)> EtaSq(result.aov, type=1)
eta.sq eta.sq.part
eta.sq.genA
8.997661e-05 0.005263158 0.0004249894
B
3.093846e-01 0.883365446 0.5938174596
C
1.439626e-03 0.068085106 0.0067567568
A:B
3.806460e-01 0.937506925 0.6426889480
A:C
5.623538e-02 0.595238095 0.2099428955
B:C
5.848479e-04 0.089655172 0.0027559890
A:B:C 3.999460e-02 0.439012346 0.1589486859>>>> #平均値を比較する棒グラフの作成> d4t <- d4[d4$C=="c1",]> m4t <- tapply(d4t[,"Y"], list(d4t[,"A"], d4t[,"B"]), mean)> barplot(m4t, beside=TRUE,legend=TRUE, ylim=c(0,20), las=1, ylab="Mean", main="C=c1")> segments(0,0,10,0)>> d4t <- d4[d4$C=="c2",]> m4t <- tapply(d4t[,"Y"], list(d4t[,"A"], d4t[,"B"]), mean)> barplot(m4t, beside=TRUE,legend=TRUE, ylim=c(0,20), las=1, ylab="Mean", main="C=c2")> segments(0,0,10,0)>243

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のある２群の分布の位置の比較 ― ウィルコクソンの符号順位検定
wilcox.test(中央値を比較したい変数１, 中央値を比較したい変数２, paired=TRUE)
paired=TRUE を指定するのを忘れないこと．忘れると対応のない検定になってしまう．
，> setwd("d:\\")> d1 <- read.table("対応のある2群の分布位置データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 患者 家族
1
1
5
4
2
2
3
2
3
3
5
3
4
4
3
3
5
5
2
3
6
6
2
2
>
> dtmp <- d1[,c(-1)]> d2 <- stack(dtmp)>>> # 標本サイズ，平均，SD，相関係数> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD 患者 家族
患者 50 2.74 1.12 1.00 0.22
家族 50 3.18 1.02 0.22 1.00>>
> # 度数分布表> t1 <- table(d1$患者)> p1 <- prop.table(t1)*100> rbind(t1,p1)
1 2 3 4 5
t1 7 16 12 13 2
p1 14 32 24 26 4
> t1p <- t1>> t1 <- table(d1$家族)> p1 <- prop.table(t1)*100> rbind(t1,p1)
1 2 3 4 5
t1 1 13 18 12 6
p1 2 26 36 24 12> t1f <- t1>> # ウィルコクソンの符号順位和検定> wilcox.test(d1$患者, d1$家族, paired=TRUE, exact=TRUE, conf.int=T)
Wilcoxon signed rank test with continuity correction
data: d1$患者 and d1$家族
V = 220.5, p-value = 0.02527
alternative hypothesis: true location shift is not equal to 0
95 percent confidence interval:-1.000032e+00 -4.890761e-05
sample estimates:(pseudo)median
-0.5
244

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

警告メッセージ:
1: In wilcox.test.default(d1$患者, d1$家族, paired = TRUE, exact = TRUE,
タイがあるため、正確な p 値を計算することができません
2: In wilcox.test.default(d1$患者, d1$家族, paired = TRUE, exact = TRUE,
タイがあるので、正確な信頼区間を計算することができません
3: In wilcox.test.default(d1$患者, d1$家族, paired = TRUE, exact = TRUE,
ゼロ値のため、正確な p 値を計算することができません
4: In wilcox.test.default(d1$患者, d1$家族, paired = TRUE, exact = TRUE,
ゼロ値のため、正確な信頼区間を計算することができません>>> # 各群の分布> barplot(t1p, ylim=c(0,20), width=0.7, space=1, xlab="Satisfaction",+ylab="Frequency", main="Patient", las=1)> segments(0,0, 10,0)>> barplot(t1f, ylim=c(0,20), width=0.7, space=1, xlab="Satisfaction",+ylab="Frequency", main="Family", las=1)> segments(0,0, 10,0)
>

>

245

:
:
:
:

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のある多群の分布の位置の比較 ― フリードマンの検定
friedman.test(as.matrix(データフレーム名))
as.matrix でデータ形式をmatrix形式にする必要がある．

> setwd("d:\\")> d1 <- read.table("対応のある多群の分布位置データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 お使い下さい 迷惑 ありがとう
1
1
5
5
4
2
2
4
4
3
3
3
4
5
4
4
4
4
4
4
5
5
4
3
3
6
6
5
4
3
>
> dtmp <- d1[,c(-1)]> d2 <- stack(dtmp)>>> # 標本サイズ，平均，SD，相関係数> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD お使い下さい 迷惑 ありがとう
お使い下さい 129 5.03 1.14
1.00 0.24
0.31
迷惑
129 4.61 1.31
0.24 1.00
0.22
ありがとう
129 4.05 1.41
0.31 0.22
1.00>> # 度数分布表> t1 <- table(d1$お使い下さい)> p1 <- prop.table(t1)*100> round(rbind(t1,p1),2)
2
3
4
5
6
7
t1 1.00 12.0 25.00 49.00 28.00 14.00
p1 0.78 9.3 19.38 37.98 21.71 10.85> t1c <- rbind(c(1:7),c(0,t1))> colnames(t1c) <- c(1:7)# カテゴリ１の人数が０人だが，グラフにこのカテゴリも# 含めるための応急処置> t1 <- table(d1$迷惑)> p1 <- prop.table(t1)*100> round(rbind(t1,p1),2)
1
2
3
4
5
6
7
t1 1.00 5.00 21.00 32.00 36.00 25.00 9.00
p1 0.78 3.88 16.28 24.81 27.91 19.38 6.98
> t1i <- t1> t1 <- table(d1$ありがとう)> p1 <- prop.table(t1)*100> round(rbind(t1,p1),2)
1
2
3
4
5
6
7
t1 1.00 15.00 35.00 34.00 20.0 17.00 7.00
p1 0.78 11.63 27.13 26.36 15.5 13.18 5.43
> t1t <- t1>
246

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #フリードマンの検定> friedman.test(as.matrix(dtmp), conf.int=T)Friedman rank sum test
data: as.matrix(dtmp)
Friedman chi-squared = 49.14, df = 2, p-value = 2.135e-11>> #各群の分布> barplot(t1c[2,], ylim=c(0,50), xlim=c(0,10), width=0.7, space=1, xlab="",+ylab="Frequency", main="Use cleanly", las=1)> segments(0,0, 10,0)>> barplot(t1i, ylim=c(0,50), xlim=c(0,10), width=0.7, space=1, xlab="",+ylab="Frequency", main="Inconvenient", las=1)> segments(0,0, 10,0)>> barplot(t1t, ylim=c(0,50), xlim=c(0,10), width=0.7, space=1, xlab="",+ylab="Frequency", main="Inconvenient", las=1)> segments(0,0, 10,0)
>
>

247

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のない２群の分布の位置の比較 ― ウィルコクソンの順位和検定(マン・ホイットニーの検定)
wilcox.test(中央値を比較したい変数 ~ 群分け変数, データフレーム名, paired=FALSE)
wilcox.test(中央値を比較したい変数１, 中央値を比較したい変数２, paired=FALSE)またはpaired=FALSE は省略可．

> setwd("d:\\")> d1 <- read.table("対応のない2群の分布位置データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 居住形態 バイト量
1
1
自宅
1
2
2
自宅
2
3
3
自宅
3
4
4
自宅
4
5
5
自宅
3
6
6
自宅
2
>
>
> # 度数分布表> (t1 <- table(d1$居住形態, d1$バイト量))

>

自宅
自宅外

1 2 3 4 5
5 11 20 23 20
4 3 14 25 20> (p1 <- round(prop.table(t1,1),2))

>
>
>

1
2
3
4
5
自宅
0.06 0.14 0.25 0.29 0.25
自宅外 0.06 0.05 0.21 0.38 0.30

> # 各群の記述統計量> library(psych)> describeBy(d1$バイト量, d1$居住形態)
group: 自宅
vars n mean sd median trimmed mad min max range skew kurtosis
se1
1 79 3.53 1.2
4
3.62 1.48
15
4 -0.43-0.77 0.13--------------------------------------------------------group: 自宅外vars n mean
sd median trimmed mad min max range skew kurtosis
se1
1 66 3.82 1.11
4
3.96 1.48
15
4 -0.910.32 0.14>>> #ウィルコクソンの順位和検定の実行> wilcox.test(バイト量~居住形態, d1, paired=FALSE)
Wilcoxon rank sum test with continuity correction
data: バイト量 by 居住形態
W = 2241, p-value = 0.1321
alternative hypothesis: true location shift is not equal to 0>>
> #群ごとのデータフレームを作成> d11 <- d1[d1$居住形態=="自宅",]> d12 <- d1[d1$居住形態=="自宅外",]>248

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #ウィルコクソンの順位和検定の実行> wilcox.test(d11$バイト量, d12$バイト量, paired=FALSE)
Wilcoxon rank sum test with continuity correction
data: d11$バイト量 and d12$バイト量
W = 2241, p-value = 0.1321
alternative hypothesis: true location shift is not equal to 0

> # 各群の分布> d1.v <- d1[d1$居住形態=="自宅",]> d1.n <- d1[d1$居住形態=="自宅外",]>> t1h <- table(d1.v$バイト量)> t1o <- table(d1.n$バイト量)>> barplot(t1h, ylim=c(0,25), xlim=c(0,7), width=0.7, space=1, xlab="Amount",+
ylab="Frequency", main="Home", las=1)> segments(0,0, 10,0)>> barplot(t1o, ylim=c(0,25), xlim=c(0,7), width=0.7, space=1, xlab="Amount",+
ylab="Frequency", main="Others", las=1)> segments(0,0, 10,0)
>
>

>
>

249

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のない多群の分布の位置の比較 ― クラスカル・ウォリスの検定
kruskal.test(中央値を比較したい変数 ~ 群分け変数, データフレーム名)
kruskal.test(データフレーム名$中央値を比較したい変数, データフレーム名$群分け変数)

または> setwd("d:\\")> d1 <- read.table("対応のない多群の分布位置データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 区分 嫌悪感
1
1 喫煙
1
2
2 禁煙
2
3
3 卒煙
5
4
4 喫煙
3
5
5 喫煙
1
6
6 喫煙
5
>
> # 度数分布表> (t1 <- table(d1$区分, d1$嫌悪感))
喫煙
禁煙
卒煙

1 2
7 10
6 6
4 5

3
7
4
8

4
3
5
9

5
2
7
7

>
> (p1 <- round(prop.table(t1,1),2))

>
>
>

1
2
3
4
5
喫煙 0.24 0.34 0.24 0.10 0.07
禁煙 0.21 0.21 0.14 0.18 0.25
卒煙 0.12 0.15 0.24 0.27 0.21

> # 各群の記述統計量> library(psych)> describeBy(d1$嫌悪感, d1$区分)
group: 喫煙vars n mean
sd median trimmed mad min max range skew kurtosis
se1
1 29 2.41 1.18
2
2.32 1.48
15
4 0.58-0.56 0.22--------------------------------------------------------group: 禁煙vars n mean
sd median trimmed mad min max range skew kurtosis
se1
1 28 3.04 1.53
3
3.04 1.48
15
40-1.57 0.29--------------------------------------------------------group: 卒煙vars n mean
sd median trimmed mad min max range skew kurtosis
se1
1 33 3.3 1.31
3
3.37 1.48
15
4 -0.31-1.08 0.23>>
> #クラスカル・ウォリスの検定> kruskal.test(嫌悪感 ~ 区分, d1)
Kruskal-Wallis rank sum test
data: 嫌悪感 by 区分
Kruskal-Wallis chi-squared = 6.6299, df = 2, p-value = 0.03634>>> # 各群の分布> d1k <- d1[d1$区分=="喫煙",]> d1s <- d1[d1$区分=="卒煙",]> d1n <- d1[d1$区分=="禁煙",]>250

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> t1s <- table(d1k$嫌悪感)> t1q <- table(d1s$嫌悪感)> t1n <- table(d1n$嫌悪感)>> barplot(t1s, ylim=c(0,10), xlim=c(0,7), width=0.7, space=1, xlab="Amount",+
ylab="Frequency", main="Smoking", las=1)> segments(0,0, 10,0)>> barplot(t1q, ylim=c(0,10), xlim=c(0,7), width=0.7, space=1, xlab="Amount",+
ylab="Frequency", main="Quit", las=1)> segments(0,0, 10,0)>> barplot(t1n, ylim=c(0,10), xlim=c(0,7), width=0.7, space=1, xlab="Amount",+
ylab="Frequency", main="Non-smoking", las=1)> segments(0,0, 10,0)>>> #3つのグラフを縦横に並べて描く設定> par(mar=c(5,4,2,1))> par(mfrow=c(3,1))> hist(d1k$嫌悪感, breaks=seq(0.5,5.5,1), ylim=c(0,10), ylab="人数", main="喫煙群", xlab="")> hist(d1s$嫌悪感, breaks=seq(0.5,5.5,1), ylim=c(0,10), ylab="人数", main="卒煙群", xlab="")> hist(d1n$嫌悪感, breaks=seq(0.5,5.5,1), ylim=c(0,10), ylab="人数", main="禁煙群", xlab="")> par(mfrow=c(1,1))

251

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

相関係数の推測
cor.test(変数名1, 変数名2, method="算出方法")
method："pearson" (default), "spearman", or "kendall"> setwd("d:\\")> d1 <- read.table("相関係数データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 ストレス うつ傾向
1
1
20
18
2
2
23
21
3
3
30
29
4
4
25
29
5
5
26
22
6
6
21
19
>
>
> dtmp <- d1[,c(-1)]>>> #記述統計量> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD ストレス うつ傾向
ストレス 154 23.39 5.14
1.00
0.62
うつ傾向 154 20.45 6.71
0.62
1.00
>
>
> #相関係数の検定（H0:ρ＝0）> cor.test(d1$ストレス, d1$うつ傾向, method="pearson")Pearson's product-moment correlation
data: d1$ストレス and d1$うつ傾向
t = 9.6234, df = 152, p-value < 2.2e-16
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
0.5064286 0.7048699
sample estimates:cor
0.6153051>> #スピアマンの順位相関係数の検定> cor.test(d1$ストレス, d1$うつ傾向, method="spearman")Spearman's rank correlation rho
data: d1$ストレス and d1$うつ傾向
S = 239103.1, p-value < 2.2e-16
alternative hypothesis: true rho is not equal to 0
sample estimates:
rho
0.6071809
警告メッセージ:
In cor.test.default(d1$ストレス, d1$うつ傾向, method = "spearman") :タイのため正確な p 値を計算することができません>>> # 散布図> plot(d1$ストレス, d1$うつ傾向, xlab="ストレス",ylab="うつ傾向", las=1, pch=19)>252

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

相関係数行列の各要素の検定
library(psych)
corr.test(データフレーム名, method="算出方法")
method："pearson" (default), "spearman", or "kendall"> setwd("d:\\")> d1 <- read.table("データ例.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id x1 x2 x3 x4
1 1 23 28 23 17
2 2 18 22 23 14
3 3 15 12 15 13
4 4 12 16 22 25
5 5 5 24 13 28
6 6 14 16 15 16>>> dtmp <- d1[,c(-1)]>>> #記述統計量> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean
SD
x1
x2
x3
x4
x1 245 15.22 5.37 1.00 -0.10 0.43 -0.26
x2 245 20.32 6.08 -0.10 1.00 -0.32 0.56
x3 245 18.52 5.12 0.43 -0.32 1.00 -0.46
x4 245 16.61 6.98 -0.26 0.56 -0.46 1.00>>
> # 相関係数行列の各要素の検定> library(psych)> (dr1 <- corr.test(dtmp))
Call:corr.test(x = dtmp)
Correlation matrix
x1
x2
x3
x4
x1 1.00 -0.10 0.43 -0.26
x2 -0.10 1.00 -0.32 0.56
x3 0.43 -0.32 1.00 -0.46
x4 -0.26 0.56 -0.46 1.00
Sample Size
[1] 245
Probability values (Entries above the diagonal are adjusted for multiple tests.)x1
x2 x3 x4
x1 0.00 0.11 0 0
x2 0.11 0.00 0 0
x3 0.00 0.00 0 0
x4 0.00 0.00 0 0
To see confidence intervals of the correlations, print with the short=FALSE option>> # t値> dr1$t
x1
x2
x3
x4
x1
Inf -1.620965 7.329962 -4.182839
x2 -1.620965
Inf -5.323804 10.559251
x3 7.329962 -5.323804
Inf -8.031193
x4 -4.182839 10.559251 -8.031193
Inf
>
>
253

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２群の相関係数の差の検定
library(psych)
独立な2群における相関係数の差(r12 vs r34)
r.test(r12=.3, r34=.5, n=100, n2=150)
対応のある2つの相関係数の差(r12 vs r34)
r.test(r12=.3, r34=.5, r13=.1, r14=.1, r23=.1, r24=.1, n=150)
１つの変数を共有する，対応のある2つの相関係数の差(r12 vs r13)
r.test(r12=.3, r13=.5, r23=.1, n=150)
あらかじめpsychパッケージをインストールしておく必要がある．

> # r.test を用いる方法> library(psych)>> # 独立な2群における相関係数の差(r12 vs r34)
> r.test(r12=.3, r34=.5, n=100, n2=150)
Correlation tests
Call:r.test(n = 100, r12 = 0.3, r34 = 0.5, n2 = 150)
Test of difference between two independent correlations
z value 1.83
with probability 0.07>>> # 対応のある2つの相関係数の差(r12 vs r34)
> r.test(r12=.3, r34=.5, r13=.1, r14=.1, r23=.1, r24=.1, n=150)
Correlation tests
Call:r.test(n = 150, r12 = 0.3, r34 = 0.5, r23 = 0.1, r13 = 0.1, r14 = 0.1,
r24 = 0.1)
Test of difference between two dependent correlations
z value -2.07
with probability 0.04>>> # １つの変数を共有する，対応のある2つの相関係数の差(r12 vs r13)
> r.test(r12=.3, r13=.5, r23=.1, n=150)
Correlation tests
Call:r.test(n = 150, r12 = 0.3, r23 = 0.1, r13 = 0.5)
Test of difference between two correlated correlations
t value -2.09
with probability < 0.038>
>
>

254

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２群の相関係数の差の信頼区間自作関数を使う
cor2.dif(n=人数ベクトル, r=相関係数ベクトル)# ----------------------------------------------------------------------------------------------cor2.dif <- function(n, r, conf=0.95){
z <- 1/2 * log((1+r)/(1-r))
d.r <- r %*% c(1, -1)
d.z <- z %*% c(1, -1)
n3 <- n - 3
inv.n3 <- 1/ n3
se <- sqrt(sum(inv.n3))
p.value <- round(2 *(1 - pnorm(abs(d.z/se))),4)za <- qnorm(1-(1-confidence)/2)
ci.l <- d.z - za * seci.u <- d.z + za * seexp.2z.l <- exp(2*ci.l)
exp.2z.u <- exp(2*ci.u)
ci.l <- round((exp.2z.l-1)/(exp.2z.l+1),4)
ci.u <- round((exp.2z.u-1)/(exp.2z.u+1),4)
title <- "Difference of two correlation coefficients"
stnames <- c("difference", "z", "p.value", paste("lower(",conf,")", sep=""), paste("upper(",conf,")", sep=""))
statistic <- data.frame(d.r, round(d.z/se,4), p.value, ci.l, ci.u)ts <- r/sqrt(1-r*r)*sqrt(n-2)
ps <- 2*(1-pt(abs(ts),n-2))
rhoTests <- round(data.frame(n,r, ts,ps),4)
colnames(rhoTests) <- c("N","r", "t", "p")colnames(statistic) <- stnamesout <- list(title, rhoTest=rhoTests, statistic=statistic)
return(out)}# ----------------------------------------------------------------------------------------------各群における無相関検定と，相関係数の差の検定，信頼区間を出力する．
conf= で信頼係数を調整できる．デフォルトは0.95．

> setwd("d:\\")> d1 <- read.table("相関係数の差データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id shurou honnin kyouin
1 1
0
29
10
2 2
0
28
17
3 3
0
24
24
4 4
0
27
26
5 5
0
30
34
6 6
0
30
30
>
> d10 <- d1[d1$shurou==0, ]> d11 <- d1[d1$shurou==1, ]>> # 記述統計量> # shurou==0> dtmp <- d10[,c(-1,-2)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD honnin kyouinhonnin 117 24.48 5.89
1.00
0.18
kyouin 117 23.38 5.76
0.18
1.00
255

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #shurou==1> dtmp <- d11[,c(-1,-2)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD honnin kyouinhonnin 153 30.24 5.59
1.0
0.3
kyouin 153 31.78 5.77
0.3
1.0
>
>
>
> # 相関係数の差の検定・信頼区間> nv <- c(nrow(d10), nrow(d11))> rv <- c(cor(d10$honnin, d10$kyouin), cor(d11$honnin, d11$kyouin))> cor2.dif(n=nv, r=rv)[[1]][1] "Difference of two correlation coefficients"$rhoTest
Nrtp
1 117 0.1779 1.9384 0.0550
2 153 0.3016 3.8873 0.0002$statistic
differencez p.value lower(0.95) upper(0.95)
1 -0.123742 -1.0584 0.2899-0.3584
0.1116>> # 散布図> plot(d10$honnin, d10$kyouin, xlim=c(10,50), ylim=c(10,50),+ main="就労経験 なし", xlab="本人評定",ylab="教員評定", las=1, pch=19)>> plot(d11$honnin, d11$kyouin, xlim=c(10,50), ylim=c(10,50),+ main="就労経験 あり", xlab="本人評定",ylab="教員評定", las=1, pch=19)>

256

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多群の相関係数の等質性の推測
自作関数を使う
cors.test(n=人数ベクトル, r=相関係数ベクトル, conf=信頼係数)# ----------------------------------------------------------------------------------------------cors.test<- function(n,r, conf=0.95){
z <- 1/2 * log((1+r)/(1-r))
n3 <- n - 3
df <- length(n) - 1
X2 <- round(sum(z*z*n3) - sum(z*n3)^2 / sum(n3),4)
p.value <- round(1 - pchisq(X2, df), 5)
title <- "Test : equality of correlation coefficients"
statistic <- round(cbind(X2, df, p.value), 4)
ts <- r/sqrt(1-r*r)*sqrt(n-2)
ps <- 2*(1-pt(abs(ts),n-2))
rhoTests <- round(data.frame(n,r, ts,ps),4)
colnames(rhoTests) <- c("N","r", "t", "p")colnames(statistic) <- c("X2","df","p")rownames(statistic) <- ""inv.n3 <- 1/ n3
npair <- length(n)*(length(n)-1)za <- qnorm(1-((1-conf)/(npair/2))/2)
pairs <- matrix(c(0), npair, 7)
k <- 0for(i in 1:length(n)){
for(j in c(1:length(n))[-i]){d.r <- r[i] - r[j]d.z <- z[i] - z[j]se <- sqrt(sum(inv.n3[i]+inv.n3[j]))p.value <- round(2 *(1 - pnorm(abs(d.z/se))),4)
ci.l <- d.z - za * seci.u <- d.z + za * seexp.2z.l <- exp(2*ci.l)
exp.2z.u <- exp(2*ci.u)
ci.l <- round((exp.2z.l-1)/(exp.2z.l+1),4)
ci.u <- round((exp.2z.u-1)/(exp.2z.u+1),4)
k <- k+1
pairs[k,] <- round(c(r[i],r[j],d.r, round(d.z/se,4), p.value, ci.l, ci.u),4)}}
rownames(pairs) <- c(1:npair)jconf <- round(100*(1-((1-conf)/(npair/2))),1)
colnames(pairs) <- c("r1","r2","diff","z","p",paste("lower(",jconf,")", sep=""), paste("upper(",
jconf,")", sep=""))
out <- list(title, rhoTest=rhoTests, statistic= statistic, CI= pairs)
return(out)}# ----------------------------------------------------------------------------------------------各群における無相関検定と，相関係数の等質性の検定，同時信頼区間を出力する．
conf= で信頼係数を調整できる．デフォルトは0.95．

> setwd("d:\\")> d1 <- read.table("相関係数の等質性データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id grade ruiji shinmitsu
1 1
L
5
4
2 2
L
5
4
3 3
L
3
2
4 4
L
2
3
5 5
L
3
3
6 6
L
5
6
>
257

名古屋 大学> # 群別データの作成> d10 <- d1[d1$grade=="L", ]> d11 <- d1[d1$grade=="M", ]> d12 <- d1[d1$grade=="H", ]>>> #記述統計量> #grade=="L"> dtmp <- d10[,c(-1,-2)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD ruiji shinmitsuruiji
92 3.98 1.25 1.00
0.22
shinmitsu 92 3.96 1.14 0.22
1.00>>
> #grade=="M"> dtmp <- d11[,c(-1,-2)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD ruiji shinmitsuruiji
108 3.60 1.27 1.00
0.34
shinmitsu 108 3.73 1.34 0.34
1.00>>
> #grade=="H"> dtmp <- d12[,c(-1,-2)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD ruiji shinmitsuruiji
102 3.47 1.36 1.00
0.52
shinmitsu 102 3.50 1.33 0.52
1.00>>
> # 相関係数の等質性> n1 <- nrow(d10)> n2 <- nrow(d11)> n3 <- nrow(d12)> nv <- c(n1,n2,n3)> r1 <- cor(d10$ruiji, d10$shinmitsu)> r2 <- cor(d11$ruiji, d11$shinmitsu)> r3 <- cor(d12$ruiji, d12$shinmitsu)> rv <- c(r1,r2,r3)> cors.test(n=nv, r=rv)[[1]][1] "Test : equality of correlation coefficients"$rhoTest
Nrtp
1 92 0.2158 2.0970 0.0388
2 108 0.3425 3.7534 0.0003
3 102 0.5209 6.1017 0.0000
258

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部$statistic
X2 dfp
6.1903 2 0.0453
$CI
r1
r2
diff
z
p lower(98.3) upper(98.3)
1 0.2158 0.3425 -0.1267 -0.9554 0.3394-0.4483
0.20442 0.2158 0.5209 -0.3050 -2.4526 0.0142-0.6094-0.0086
3 0.3425 0.2158 0.1267 0.9554 0.3394-0.20440.4483
4 0.3425 0.5209 -0.1784 -1.5747 0.1153-0.5050
0.11435 0.5209 0.2158 0.3050 2.4526 0.0142
0.00860.6094
6 0.5209 0.3425 0.1784 1.5747 0.1153-0.11430.5050>259

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２×２表 ― ファイ係数，カイ2乗検定，尤度比検定，フィッシャーの正確検定
クロス表の出力とともに検定結果を表示
library(descr)
CrossTable(変数１, 変数２, chisq=T, fisher=T)
あらかじめdescrパッケージをインストールしておく必要がある．
ピアソンのカイ２乗検定，イエーツの連続修正カイ２乗検定，フィッシャーの正確検定を行う．
ファイ係数
library(effectsize)phi(テーブル名)
あらかじめeffectsizeパッケージをインストールしておく必要がある。
イエーツの連続修正を行ったカイ２乗検定
chisq.test(テーブル名)
尤度比検定・ピアソンのカイ２乗検定
library(vcd)
assocstats(テーブル名)
あらかじめvcdパッケージをインストールしておく必要がある．
フィッシャーの正確検定
fisher.test(テーブル名)> setwd("d:\\")> d1 <- read.table("ファイ係数データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 通塾 睡眠不足
1
1
1
0
2
2
1
1
3
3
1
1
4
4
0
1
5
5
1
1
6
6
1
1
>
> # ファイ係数> (t1 <- table(d1$通塾, d1$睡眠不足))
0 1
0 30 10
1 20 40> library(effectsize)> phi(t1, alternative="two.sided")Phi (adj.) |95% CI------------------------0.40| [0.19, 0.60]>> #クロス表と検定> d1$通塾 <- factor(d1$通塾, levels=c(1,0), labels=c("yes", "no"))> d1$睡眠不足 <- factor(d1$睡眠不足, levels=c(1,0), labels=c("yes", "no"))260

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> library(descr)> (ct1 <-CrossTable(d1$通塾, d1$睡眠不足, expected=T, chisq=T, fisher=T))
Cell Contents|-------------------------||N ||Expected N || Chi-square contribution ||N / Row Total ||N / Col Total ||N / Table Total ||-------------------------|================================
d1$睡眠不足
d1$通塾
yes
no
Total
-------------------------------yes
40
20
60
30.0
30.0
3.333
3.333
0.667
0.333
0.600
0.800
0.400
0.400
0.200
-------------------------------no
10
30
40
20.0
20.0
5.000
5.000
0.250
0.750
0.400
0.200
0.600
0.100
0.300
-------------------------------Total
50
50
100
0.500
0.500
================================
Statistics for All Table Factors
Pearson's Chi-squared test-----------------------------------------------------------Chi^2 = 16.66667
d.f. = 1
p = 4.455709e-05
Pearson's Chi-squared test with Yates' continuity correction-----------------------------------------------------------Chi^2 = 15.04167
d.f. = 1
p = 0.0001051636
Fisher's Exact Test for Count Data-----------------------------------------------------------Sample estimate odds ratio: 5.881258
Alternative hypothesis: true odds ratio is not equal to 1
p = 8.31e-05
95% confidence interval: 2.265787 16.39092
Alternative hypothesis: true odds ratio is less than 1
p = 1
95%s confidence interval: % 0 14.03583
Alternative hypothesis: true odds ratio is greater than 1
p = 4.15e-05
95%s confidence interval: % 2.58798 Inf
>
>

261

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #イエーツの連続修正を行ったカイ2乗検定> chisq.test(t1)Pearson's Chi-squared test with Yates' continuity correction
data: t1
X-squared = 15.042, df = 1, p-value = 0.0001052> #尤度比検定・ピアソンのカイ2乗検定> library(vcd)> assocstats(t1)X^2 dfP(> X^2)
Likelihood Ratio 17.261 1 3.2582e-05
Pearson16.667 1 4.4557e-05
Phi-Coefficient: 0.408
Contingency Coeff.: 0.378
Cramer's V: 0.408> #フィッシャーの正確検定> fisher.test(t1)Fisher's Exact Test for Count Data
data: t1
p-value = 8.309e-05
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
2.265787 16.390918
sample estimates:
odds ratio
5.881258

262

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ｒ×ｃ表 ― クラメルの連関係数，カイ2乗検定，尤度比検定
クロス表の出力とともに検定結果を表示
library(descr)
CrossTable(変数１, 変数２, chisq=T, fisher=T)
あらかじめdescrパッケージをインストールしておく必要がある．
ピアソンのカイ２乗検定，フィッシャーの正確検定を行う．
クラメルの連関係数
library(vcd)
assocstats(テーブル名)
あらかじめvcdパッケージをインストールしておく必要がある．
尤度比検定・ピアソンのカイ２乗検定
library(vcd)
assocstats(テーブル名)
あらかじめvcdパッケージをインストールしておく必要がある．
フィッシャーの正確検定
fisher.test(テーブル名)> setwd("d:\\")> d1 <- read.table("連関係数データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 モラトリアム 進路
1
1
低 就職
2
2
高 未定
3
3
高 就職
4
4
高 未定
5
5
高 進学
6
6
高 未定

> # 表を見やすくするため，カテゴリの順番を指定> d1$モラトリアム <- factor(d1$モラトリアム, levels=c("高","低"), labels=c("高", "低"))> d1$進路 <- factor(d1$進路, levels=c("進学","就職","未定"), labels=c("進学","就職", "未定"))263

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #クロス表と検定> d1$モラトリアム <- factor(d1$モラトリアム, levels=c("高","低"), labels=c("高", "低"))> d1$進路 <- factor(d1$進路, levels=c("就職","進学","未定"), labels=c("就職", "進学","未定"))> library(descr)> (ct1 <- CrossTable(d1$モラトリアム, d1$進路, expected=T, chisq=T, fisher=T))
Cell Contents|-------------------------||N ||Expected N || Chi-square contribution ||N / Row Total ||N / Col Total ||N / Table Total ||-------------------------|================================================
d1$進路
d1$モラトリアム
就職
進学
未定
Total
-----------------------------------------------高
62
29
36
127
67.2
33.9
25.9
0.408
0.699
3.940
0.488
0.228
0.283
0.498
0.459
0.426
0.692
0.243
0.114
0.141
-----------------------------------------------低
73
39
16
128
67.8
34.1
26.1
0.404
0.694
3.910
0.570
0.305
0.125
0.502
0.541
0.574
0.308
0.286
0.153
0.063
-----------------------------------------------Total
135
68
52
255
0.529
0.267
0.204
================================================
Statistics for All Table Factors
Pearson's Chi-squared test-----------------------------------------------------------Chi^2 = 10.05543
d.f. = 2
p = 0.00655

Fisher's Exact Test for Count Data-----------------------------------------------------------Alternative hypothesis: two.sided
p = 0.00614>> #連関係数の検定> (t1 <- table(d1$モラトリアム, d1$進路))>

高低

就職 進学 未定
62
29
36
73
39
16

264

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # クラメルの連関係数・尤度比検定・ピアソンのカイ２乗検定> library(vcd)> assocstats(t1)X^2 df P(> X^2)
Likelihood Ratio 10.263 2 0.0059063
Pearson10.055 2 0.0065538
Phi-Coefficient: 0.199
Contingency Coeff.: 0.195
Cramer's V: 0.199>> # フィッシャーの正確検定> fisher.test(t1)Fisher's Exact Test for Count Data
data: t1
p-value = 0.006138
alternative hypothesis: two.sided

Contingency Coefficientについて連関の指標の1つとして，ピアソンの Contingency Coefficient というものがあります。これは，値が0になるとき連関無し（独立）であることを表しますが，完全な連関があっても値は1になりません（表のサイズに依存した，1未満の値になります）。計算式は，ピアソンのカイ乗値を，ピアソンのカイ2乗値に総度数を加えたもので割った値の，平方根 です。
ピアソンの Contingency Coefficient が使われることはまずありません。
Contingency Coefficient と，評定の一致度などを表すコーエンの一致係数（カッパ係数）とはまったく異なるものです。

265

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ピアソン残差・デビアンス残差
標準化ピアソン残差（調整済み標準化残差）
Library(descr)
CrossTable(変数名１, 変数名２, asresid=T))
あらかじめdescrパッケージをインストールしておく必要がある．

対数線形モデルを用いる方法
フラットテーブル
t2 <- ftable(d1[,c("変数名１","変数名２")],row.vars=c("変数名１","変数名２"))t2 <- as.data.frame(t2))
対数線形モデル
result.1 <- glm(Freq ~ 変数名１ + 変数名２, data=フラットテーブル名, family=poisson)
ピアソン残差(peares.1 <- resid(対数線形モデル出力名, type="pearson"))
標準化ピアソン残差
xtabs(rstandard(対数線形モデル出力名, type="pearson")~フラットテーブル$変数名１+ フラットテーブル$変数名２)
デビアンス残差(devres.1 <- resid(対数線形モデル出力名, type="deviance"))
標準化デビアンス残差
xtabs(rstandard(対数線形モデル出力名, type="deviance")~フラットテーブル$変数名１+ フラットテーブ
ル$変数名２)> setwd("d:\\")> d1 <- read.table("連関係数データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 モラトリアム 進路
1
1
低 就職
2
2
高 未定
3
3
高 就職
4
4
高 未定
5
5
高 進学
6
6
高 未定
>

> # 表を見やすくするため，カテゴリの順番を指定> d1$モラトリアム <- factor(d1$モラトリアム, levels=c("高","低"), labels=c("高", "低"))> d1$進路 <- factor(d1$進路, levels=c("就職","進学","未定"), labels=c("就職", "進学","未定"))> library(descr)> (ct1 <- CrossTable(d1$モラトリアム, d1$進路, expected=T, asresid=T))
Cell Contents|-------------------------||N ||Expected N || Chi-square contribution ||N / Row Total ||N / Col Total ||N / Table Total ||Adj Std Resid ||-------------------------|

266

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部===================================================
d1$進路
d1$モラトリアム
就職
進学
未定
Total
--------------------------------------------------高
62
29
36
127
67.2
33.9
25.9
0.408
0.699
3.940
0.488
0.228
0.283
0.498
0.459
0.426
0.692
0.243
0.114
0.141
-1.314-1.3783.140--------------------------------------------------低
73
39
16
128
67.8
34.1
26.1
0.404
0.694
3.910
0.570
0.305
0.125
0.502
0.541
0.574
0.308
0.286
0.153
0.063
1.314
1.378
-3.140--------------------------------------------------Total
135
68
52
255
0.529
0.267
0.204
===================================================>>>> # 残差計算の準備> # フラットテーブル> t2 <- ftable(d1[,c("モラトリアム","進路")], row.vars=c("モラトリアム","進路"))> (t2 <- as.data.frame(t2))
モラトリアム 進路 Freq
1
高 就職
62
2
低 就職
73
3
高 進学
29
4
低 進学
39
5
高 未定
36
6
低 未定
16
> # 対数線形モデル> result.1 <- glm(Freq ~ モラトリアム + 進路, data=t2, family=poisson)> summary(result.1)
Call:glm(formula = Freq ~ モラトリアム + 進路, family = poisson, data = t2)
Deviance Residuals:
12
3-0.64700.6280 -0.8576

40.81435
1.87336-2.1313

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept)
4.208198
0.106583 39.483 < 2e-16 ***モラトリアム低 0.007843
0.125246
0.063
0.95
進路進学
-0.685767
0.148705 -4.612 4.00e-06 ***進路未定-0.954031
0.163212 -5.845 5.05e-09 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for poisson family taken to be 1)
Null deviance: 53.722
Residual deviance: 10.263
AIC: 51.125

on 5
on 2

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 4267

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 標準化ピアソン残差（調整済み標準化残差）> # ピアソン残差> (peares.1 <- resid(result.1, type="pearson"))
1
2
3
4
5
6
-0.6384728 0.6359739 -0.8362678 0.8329947 1.9850536 -1.9772843>> # 標準化ピアソン残差> xtabs(rstandard(result.1, type="pearson")~t2$モラトリアム+ t2$進路)
t2$進路
t2$モラトリアム
就職
進学
未定
高 -1.313671 -1.378350 3.140217
低 1.313672 1.378351 -3.140217>> # デビアンス残差> (devres.1 <- resid(result.1, type="deviance"))
1
2
3
4
5
6
-0.6470397 0.6280379 -0.8576008 0.8142911 1.8733391 -2.1312969>> # 標準化デビアンス残差> xtabs(rstandard(result.1, type="deviance")~t2$モラトリアム+ t2$進路)
t2$進路
t2$モラトリアム
就職
進学
未定
高 -1.331298 -1.413512 2.963492
低 1.297279 1.347402 -3.384812
>
>
>

268

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２名の評定者の評定の一致度 ― コーエンのカッパ係数
vcdパッケージを使う方法
library(vcd)
Kappa(テーブル名)
あらかじめvcdパッケージをインストールしておく必要がある．
pschパッケージを使う方法
library(psych)
cohen.kappa(テーブル名)
あらかじめpsychパッケージをインストールしておく必要がある．
irr パッケージを使う方法
library(irr)kappa2(データフレーム名)
あらかじめirrパッケージをインストールしておく必要がある．
weight オプションを指定することにより，重みカッパ係数を算出する。
weight には"unweighted"（デフォルト）, "equal", "squared"の水準がある。

> setwd("d:\\")> d1 <- read.table("カッパ係数_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id rater1 rater2
1 1
1
1
2 2
1
1
3 3
1
1
4 4
1
1
5 5
1
1
6 6
1
1
>
> #評定データフレームの作成> d2 <- d1[,c(-1)]>> #クロス表の作成> (t1 <-table(d1$rater1, d1$rater2))
1 2 3
1 6 1 12 1 7 03 2 1 6>> # vcdパッケージを使う方法> library(vcd)> Kappa(t1)
value
ASE
z Pr(>|z|)Unweighted 0.6411 0.1268 5.056 4.278e-07
Weighted
0.5946 0.1501 3.962 7.421e-05
>
>

269

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # pschパッケージを使う方法> library(psych)> cohen.kappa(t1)Call: cohen.kappa1(x = x, w = w, n.obs = n.obs, alpha = alpha, levels = levels)
Cohen Kappa and Weighted Kappa correlation coefficients and confidence boundaries
lower estimate upper
unweighted kappa 0.39
0.64 0.89
weighted kappa
0.18
0.55 0.92
Number of subjects = 25
警告メッセージ:
any(abs(bounds)) で:'double' 型の引数を論理型に変換します>> # irr パッケージを使う方法> library(irr)> kappa2(d2)Cohen's Kappa for 2 Raters (Weights: unweighted)
Subjects = 25
Raters = 2
Kappa = 0.641
z = 4.57
p-value = 4.78e-06> kappa2(d2, weight="equal")
Cohen's Kappa for 2 Raters (Weights: equal)
Subjects = 25
Raters = 2
Kappa = 0.595
z = 3.81
p-value = 0.000137> kappa2(d2, weight="squared")
Cohen's Kappa for 2 Raters (Weights: squared)
Subjects = 25
Raters = 2
Kappa = 0.548
z = 2.77
p-value = 0.00561
>
>

270

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

複数名の評定者の評定の一致度 ― Fleissのカッパ係数
irr パッケージを使う方法
library(irr)kappam.fleiss(データフレーム名)
あらかじめirrパッケージをインストールしておく必要がある．

> setwd("d:\\")> d1 <- read.table("カッパ係数Fleiss_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id rater1 rater2 rater3 rater4
1 1
1
1
1
1
2 2
1
1
1
1
3 3
1
1
1
1
4 4
1
1
1
2
5 5
1
1
2
3
6 6
1
1
2
3
>
> #評定データフレームの作成> d2 <- d1[,c(-1)]>>>> # irr パッケージを使う方法> library(irr)> kappam.fleiss(d2)Fleiss' Kappa for m Raters
Subjects = 25
Raters = 4
Kappa = 0.31
z = 5.32
p-value = 1.01e-07
>
>

271

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

１群の比率の推測 － 二項検定
二項検定
binom.test(テーブル名,

p=設定値)

近似検定
prop.test(テーブル名,

p=設定値)>> setwd("d:\\")> d1 <- read.table("1群の比率データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 合否
1
1
1
2
2
1
3
3
0
4
4
1
5
5
1
6
6
1
>
> # 度数分布表> d1$gouhi <- factor(d1$合否, levels=c(1,0), labels=c("success","failure"))> (t1 <- table(d1$gouhi))
success failure
196>>> # 設定値> p0 <- 0.6> # 二項検定> binom.test(t1,p=p0)

Exact binomial test
data: t1
number of successes = 19, number of trials = 25, p-value = 0.1514
alternative hypothesis: true probability of success is not equal to 0.6
95 percent confidence interval:
0.5487120 0.9064356
sample estimates:
probability of success
0.76> # 近似検定> prop.test(t1,p=p0)

1-sample proportions test with continuity correction
data: t1, null probability p0
X-squared = 2.0417, df = 1, p-value = 0.153
alternative hypothesis: true p is not equal to 0.6
95 percent confidence interval:
0.5447916 0.8984194
sample estimates:
p
0.76
>
>
>

272

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のある２群の比率の比較 ― マクネマーの検定
library(descr)
CrossTable(変数名１, 変数名２, mcnemar=T)
またはmcnemar.test(変数名１, 変数名２)
mcnemar.test(テーブル名)

対応のある比率の差の信頼区間を推定する関数
dPP2(x=変数名１, y=変数名２)
conf=で信頼係数を設定できる．デフォルトは0.95．
#----------------------------------------------------dPP2 <- function(data, conf=0.95){
t1 <- table(data)a <- t1[1,1]b <- t1[1,2]c <- t1[2,1]d <- t1[2,2]n <- sum(t1)se <- sqrt(b+c-(b-c)^2/n)/np1 <- mean(data[,1])p2 <- mean(data[,2])z0 <- qnorm((1-(1-conf)/2))
ci.l <- p1-p2-z0*se
ci.u <- p1-p2+z0*se
title <- "Difference of paired proportions"stnames <- c("p1","p2","difference", paste("lower(",conf,")", sep=""), paste("upper(",conf,")",
sep=""))
statistic <- round(data.frame(p1, p2,(p1-p2), ci.l, ci.u), 4)
colnames(statistic) <- stnamesout <- list(title, statistic=statistic)
return(out)}#------------------------------------------------------> setwd("d:\\")> d1 <- read.table("対応のある2群の比率データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 子ども 親
1
1
1 1
2
2
1 1
3
3
1 1
4
4
1 1
5
5
1 1
6
6
1 1
>
>
> # 各群における比率> colMeans(d1[c("子ども","親")])子ども
親0.6133333 0.4400000>>
273

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #クロス表と検定> library(descr)> (t1 <- CrossTable(d1$子ども, d1$親, mcnemar=T))
Cell Contents|-------------------------||N || Chi-square contribution ||N / Row Total ||N / Col Total ||N / Table Total ||-------------------------|==================================
d1$親
d1$子ども01
Total---------------------------------0
21
8
29
1.395
1.776
0.724
0.276
0.387
0.500
0.242
0.280
0.107
---------------------------------1
21
25
46
0.880
1.119
0.457
0.543
0.613
0.500
0.758
0.280
0.333
---------------------------------Total
42
33
75
0.560
0.440
==================================

McNemar's Chi-squared test-----------------------------------------------------------Chi^2 = 5.827586
d.f. = 1
p = 0.01577676
McNemar's Chi-squared test with continuity correction-----------------------------------------------------------Chi^2 = 4.965517
d.f. = 1
p = 0.02585758>>> #マクネマーの検定> mcnemar.test(d1$子ども, d1$親)McNemar's Chi-squared test with continuity correction
data: d1$子ども and d1$親McNemar's chi-squared = 4.9655, df = 1, p-value = 0.02586>> #対応のある比率の差の信頼区間> dPP2(data=d1[,c("子ども","親")])[[1]][1] "Difference of paired proportions"$statistic
p1
p2 difference lower(0.95) upper(0.95)
1 0.6133 0.44
0.17330.03820.3085274

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のある多群の比率の比較 ― コクランのＱ検定
cochranq.test(データ名)
あらかじめCVSTパッケージをインストールしておく必要がある．
データは，分析したい変数だけ残して，不要な変数は削除しておく．
同時信頼区間dPPs(data=データ名)#----------------------------------------------------dPPs <- function(data, conf=0.95){
nc <- ncol(data)
npair <- (nc*(nc-1))/2
pairs <- matrix(c(0), npair, 5)k <- 0for(i in 1:(nc-1)){
for(j in (i+1):nc){d2 <- data[,c(i,j)]t1 <- table(d2)a <- t1[1,1]b <- t1[1,2]c <- t1[2,1]d <- t1[2,2]n <- sum(t1)se <- sqrt(b+c-(b-c)^2/n)/np1 <- mean(data[,i])p2 <- mean(data[,j])z0 <- qnorm((1-((1-conf)/(npair/2))/2))
ci.l <- p1-p2-z0*se
ci.u <- p1-p2+z0*se
k <- k+1
pairs[k,] <- round(c(p1, p2, (p1-p2), ci.l, ci.u),4)}}
rownames(pairs) <- c(1:npair)jconf <- round(100*(1-((1-conf)/(npair/2))),1)
colnames(pairs) <- c("p1","p2","diff",paste("lower(",jconf,")", sep=""), paste("upper(",jconf,")", sep=""))
title <- paste("Joint ", 100*conf,"% Confidence Intervals", sep="")out <- list(title, CI= pairs)
return(out)}#------------------------------------------------------> setwd("d:\\")> d1 <- read.table("対応のある多群の比率データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 福祉系 教育系 幼保系
1
1
0
0
0
2
2
1
0
0
3
3
1
1
1
4
4
1
1
0
5
5
0
0
1
6
6
1
0
0
>
>
> # 各群の比率> colMeans(d1[,c("福祉系","教育系","幼保系")])
福祉系
教育系
幼保系
0.7232143 0.4196429 0.6071429>>> # cochran.Qを使う方法> library(CVST)> cochranq.test(d1[,c("福祉系","教育系","幼保系")])
275

名古屋 大学
Cochran's Q Test
data: d1[, c("福祉系", "教育系", "幼保系")]
Cochran's Q = 22.075, df = 2, p-value = 1.609e-05>>>> # 対応のある比率の差の信頼区間> dPPs(data=d1[,c("福祉系","教育系","幼保系")])[1] "Joint 95% Confidence Intervals"
$CI

p1
p2
diff lower(96.7) upper(96.7)
1 0.7232 0.4196 0.3036
0.16700.4402
2 0.7232 0.6071 0.1161-0.00030.2324
3 0.4196 0.6071 -0.1875-0.3285-0.0465>>276

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

リスク差・リスク比・オッズ比の推測
リスク差
prop.test(テーブル名)
リスク比・オッズ比library(epitools)
epitab(テーブル名, method=c("riskratio"))
epitab(テーブル名, method=c("oddsratio"))
データ値を，「0＝なし，1＝あり」（「なし」のほうが小さい値）としておかなければならない
CrossTable関数による見やすい表と，table関数で作成して，リスク比・オッズ比を計算する元になる表で，行および列の1,0の並び順が逆になることに注意する．
あらかじめepitoolsパッケージをインストールしておく必要がある．
method で "oddsratio" か "riskratio" かを指定する．"rateratio" というオプションもある．
vcdパッケージにもoddsratioという関数がある．オッズ比の計算をしてくれる．

> setwd("d:\\")>> # 前向き研究> d1 <- read.table("対応のない2群の比率データ前.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1))
番号 身内患者 医療関係
1
1
0
0
2
2
0
0
3
3
1
1
4
4
1
0
5
5
1
1
6
6
0
1
>

> # クロス表> d1$身内患者rev <- factor(d1$身内患者, levels=c(1,0))> d1$医療関係rev <- factor(d1$医療関係, levels=c(1,0))> library(descr)> CrossTable(d1$身内患者rev, d1$医療関係rev, prop.chisq=F,prop.c=F, prop.t=F)
Cell Contents|-------------------------||N ||N / Row Total ||-------------------------|=======================================
d1$医療関係rev
d1$身内患者rev
1
0
Total
--------------------------------------1
30
45
75
0.400
0.600
0.500
--------------------------------------0
15
60
75
0.200
0.800
0.500
--------------------------------------Total
45
105
150
=======================================>

277

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # リスク差> (t1 <- table(d1$身内患者, d1$医療関係))
0 1
0 60 15
1 45 30> prop.test(t1)2-sample test for equality of proportions with continuity
correction
data: t1
X-squared = 6.2222, df = 1, p-value = 0.01262
alternative hypothesis: two.sided
95 percent confidence interval:
0.04353114 0.35646886
sample estimates:
prop 1 prop 2
0.8
0.6
>

> # リスク比> library(epitools)> epitab(t1, method=c("riskratio"))$tab
0 p0 1 p1 riskratio
lower
upper
p.value
0 60 0.8 15 0.2
1
NA
NA
NA
1 45 0.6 30 0.4
2 1.176315 3.400451 0.01215822$measure[1] "wald"$conf.level[1] 0.95$pvalue[1] "fisher.exact">> # オッズ比> library(epitools)> epitab(t1, method=c("oddsratio"))
$tab
0
p0 1
p1 oddsratio
lower
upper
p.value
0 60 0.5714286 15 0.3333333 1.000000
NANANA
1 45 0.4285714 30 0.6666667 2.666667 1.284531 5.535958 0.01215822$measure[1] "wald"$conf.level[1] 0.95$pvalue[1] "fisher.exact"278

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> # 後ろ向き研究> d1 <- read.table("対応のない2群の比率データ後.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1))
番号 医療関係 身内患者
1
1
0
0
2
2
0
0
3
3
1
0
4
4
1
0
5
5
0
0
6
6
0
0
>

> # クロス表> d1$身内患者rev <- factor(d1$身内患者, levels=c(1,0))> d1$医療関係rev <- factor(d1$医療関係, levels=c(1,0))> library(descr)> CrossTable(d1$身内患者rev, d1$医療関係rev, prop.chisq=F,prop.r=F, prop.t=F)
Cell Contents|-------------------------||N ||N / Col Total ||-------------------------|=======================================
d1$医療関係rev
d1$身内患者rev
1
0
Total
--------------------------------------1
25
12
37
0.333
0.158
--------------------------------------0
50
64
114
0.667
0.842
--------------------------------------Total
75
76
151
0.497
0.503
=======================================>> # オッズ比> library(epitools)> epitab(t1, method=c("oddsratio"))
$tab
0
p0 1
p1 oddsratio
lower
upper
p.value
0 60 0.5714286 15 0.3333333 1.000000
NANANA
1 45 0.4285714 30 0.6666667 2.666667 1.284531 5.535958 0.01215822$measure[1] "wald"$conf.level[1] 0.95$pvalue[1] "fisher.exact"

>
>

>
>
279

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 横断研究> d1 <- read.table("対応のない2群の比率データ横.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1))
番号 身内患者 医療関係
1
1
0
0
2
2
1
0
3
3
0
1
4
4
0
0
5
5
0
0
6
6
1
0
>

> # クロス表> d1$身内患者rev <- factor(d1$身内患者, levels=c(1,0))> d1$医療関係rev <- factor(d1$医療関係, levels=c(1,0))> library(descr)> CrossTable(d1$身内患者rev, d1$医療関係rev, prop.chisq=F)
Cell Contents|-------------------------||N ||N / Row Total ||N / Col Total ||N / Table Total ||-------------------------|=======================================
d1$医療関係rev
d1$身内患者rev
1
0
Total
--------------------------------------1
18
12
30
0.600
0.400
0.200
0.375
0.118
0.120
0.080
--------------------------------------0
30
90
120
0.250
0.750
0.800
0.625
0.882
0.200
0.600
--------------------------------------Total
48
102
150
0.320
0.680
=======================================>> # リスク差> (t1 <- table(d1$身内患者, d1$医療関係))
0 1
0 90 30
1 12 18> prop.test(t1)2-sample test for equality of proportions with continuity
correction
data: t1
X-squared = 11.9504, df = 1, p-value = 0.0005463
alternative hypothesis: two.sided
95 percent confidence interval:
0.1375056 0.5624944
sample estimates:
prop 1 prop 2
0.75
0.40
>
280

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # リスク比> library(epitools)> epitab(t1, method=c("riskratio"))
$tab
0
p0 1
p1 riskratio
lower
upper
p.value
0 90 0.75 30 0.25
1.0
NA
NA
NA
1 12 0.40 18 0.60
2.4 1.567615 3.674372 0.0004215309$measure[1] "wald"$conf.level[1] 0.95$pvalue[1] "fisher.exact">> # オッズ比> library(epitools)> epitab(t1, method=c("oddsratio"))
$tab
0
p0 1
p1 oddsratio
lower
upper
p.value
0 90 0.8823529 30 0.625
1.0
NA
NA
NA
1 12 0.1176471 18 0.375
4.5 1.94424 10.41538 0.0004215309$measure[1] "wald"$conf.level[1] 0.95$pvalue[1] "fisher.exact"281

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応のない多群の比率の等質性の推測
prop.test(テーブル名)
同時信頼区間dNPs(x=群分け変数名, y=0/1変数名)#----------------------------------------------------dNPs <- function(x, y, conf=0.95){
t1 <- table(x,y)
nc <- length(levels(x))
npair <- (nc*(nc-1))/2
pairs <- matrix(c(0), npair, 5)k <- 0for(i in 1:(nc-1)){
for(j in (i+1) : nc){t12 <- t1[c(i,j),]tt <- prop.test(t12, conf.level=(1-((1-conf)/(npair/2))))
p1 <- tt$estimate[1]p2 <- tt$estimate[2]ci.l <- tt$conf.int[1]ci.u <- tt$conf.int[2]k <- k+1
pairs[k,] <- round(c(p1, p2, (p1-p2), ci.l, ci.u),4)}}
rownames(pairs) <- c(1:npair)jconf <- round(100*(1-((1-conf)/(npair/2))),1)
colnames(pairs) <- c("p1","p2","diff",paste("lower(",jconf,")", sep=""), paste("upper(",jconf,")", sep=""))
title <- paste("Joint ", 100*conf,"% Confidence Intervals", sep="")out <- list(title, CI= pairs)
return(out)}#------------------------------------------------------> setwd("d:\\")> d1 <- read.table("対応のない多群の比率データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 地域 罹患
1
1
A
1
2
2
C
0
3
3
B
0
4
4
B
0
5
5
C
0
6
6
A
1
>
>
> # クロス表> d1$地域 <- factor(d1$地域, levels=c("A","B","C"))> d1$罹患 <- factor(d1$罹患, levels=c(1,0))> library(descr)> CrossTable(d1$地域, d1$罹患, prop.chisq=F,prop.c=F, prop.t=F)
Cell Contents|-------------------------||N ||N / Row Total ||-------------------------|================================
d1$罹患
d1$地域
1
0
Total
-------------------------------A
12
22
34
0.353
0.647
0.239
-------------------------------B
8
38
46
0.174
0.826
0.324
282

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部-------------------------------C
26
36
62
0.419
0.581
0.437
-------------------------------Total
46
96
142
================================>>> # 対応のない多群の比率> (t1 <- table(d1$地域, d1$罹患))
1 0
A 12 22B 8 38C 26 36> prop.test(t1)3-sample test for equality of proportions without continuity
correction
data: t1
X-squared = 7.4355, df = 2, p-value = 0.02429
alternative hypothesis: two.sided
sample estimates:
prop 1prop 2
prop 30.3529412 0.1739130 0.4193548>>>> # 対応のない比率の差の信頼区間> dNPs(x=d1$地域, y=d1$罹患)[1] "Joint 95% Confidence Intervals"
$CI
p1
p2
diff lower(96.7) upper(96.7)
1 0.3529 0.1739 0.1790-0.0576
0.4157
2 0.3529 0.4194 -0.0664-0.3087
0.17593 0.1739 0.4194 -0.2454-0.4431-0.0478>>283

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

単回帰分析 ― lm関数
オブジェクト名 <- lm(基準変数 ~ 説明変数, データフレーム名)
summary(オブジェクト名)lm()でモデルを指定し，結果を「オブジェクト名」に保存する．その内容をsummary()で表示する．

> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 記述統計量> dtmp <- d1[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu work result
stress 245 22.94 5.25
1.00
0.40
-0.34 0.62 0.03
0.44
kyoufu 245 4.05 1.17
0.40
1.00
-0.03 0.31 0.10
0.20
support 245 18.42 4.96 -0.34 -0.03
1.00 -0.51 -0.03 -0.39
utsu
245 20.29 6.49
0.62
0.31
-0.51 1.00 0.02
0.76
work
245 0.50 0.50
0.03
0.10
-0.03 0.02 1.00 -0.08
result 245 0.26 0.44
0.44
0.20
-0.39 0.76 -0.08
1.00>>> # 単回帰分析> reg.1 <- lm(utsu ~ stress, data=d1)> summary(reg.1)
Call:lm(formula = utsu ~ stress, data = d1)
Residuals:Min
1Q-11.6277 -3.2181

Median-0.0374

3Q
3.0771Max
15.6674

Coefficients:
Estimate Std. Error t value Pr(>|t|)(Intercept) 2.73611
1.46777
1.864
0.0635 .
stress
0.76506
0.06238 12.264<2e-16 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 5.114 on 243 degrees of freedom
Multiple R-squared: 0.3823,
Adjusted R-squared: 0.3798
F-statistic: 150.4 on 1 and 243 DF, p-value: < 2.2e-16>>> #偏回帰係数の信頼区間> confint(reg.1)
2.5 %
97.5 %(Intercept) -0.1550688 5.6272812
stress
0.6421862 0.8879398>>
284

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #散布図と回帰直線を描く> plot(d1$stress, d1$utsu, xlim=c(0,40), ylim=c(0,40),+
pch=20, las=1, xlab="ストレス", ylab="うつ傾向")>> #回帰直線> abline(reg.1, lwd=2)> (a <- reg.1$coefficients["(Intercept)"])(Intercept)
2.736106> (b <- reg.1$coefficients["stress"])stress
0.765063> segments(-1,38,0.5, 38, lwd=2, lty=1)> text(1, 38, paste("Y = ", round(a,2)," + ", round(b,2)," X", sep=""),pos=4)>>>> # データの標準化> d2 <- as.data.frame(scale(d1[,c("stress","kyoufu","support","utsu")]))>> #共分散行列の確認> cov(d2)stresskyoufusupportutsu
stress1.0000000 0.40369513 -0.33786517 0.6183281
kyoufu0.4036951 1.00000000 -0.02670051 0.3124069
support -0.3378652 -0.02670051 1.00000000 -0.5064285
utsu
0.6183281 0.31240691 -0.50642854 1.0000000> #標準偏回帰係数の推定> reg.2 <- lm(utsu ~ stress, data=d2)> summary(reg.2)
Call:lm(formula = utsu ~ stress, data = d2)
Residuals:
Min
1Q
Median-1.79071 -0.49560 -0.00575

3Q
0.47388

Max
2.41283

Coefficients:
Estimate Std. Error t value Pr(>|t|)(Intercept) 1.448e-16 5.031e-02
0.00
1stress6.183e-01 5.042e-02
12.26<2e-16 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7875 on 243 degrees of freedom
Multiple R-squared: 0.3823,
Adjusted R-squared: 0.3798
F-statistic: 150.4 on 1 and 243 DF, p-value: < 2.2e-16>> #（標準）偏回帰係数の信頼区間> confint(reg.2)
2.5 %
97.5 %(Intercept) -0.09910683 0.09910683
stress
0.51901839 0.71763782>>> # 残差プロット> plot(reg.1$fitted.values, reg.1$residuals, pch=20, las=1,+
ylim=c(-15,15), xlab="予測値", ylab="残差", main="")> segments(5,0,40,0)
>
>

285

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

重回帰分析 ― lm関数
偏回帰係数の推定と信頼区間
オブジェクト名1 <- lm(基準変数 ~ 説明変数1 + 説明変数2 + …, データフレーム名1)summary(オブジェクト名1)
confint(オブジェクト名1)
標準偏回帰係数の推定と信頼区間
データフレーム名2 <- as.data.frame(scale(データフレーム名1)
オブジェクト名2 <- lm(基準変数 ~ 説明変数1 + 説明変数2 + …, データフレーム名2)summary(オブジェクト名2)
confint(オブジェクト名2)
多重共線性の診断
VIF <- diag(solve(cor(説明変数間の相関係数行列)))VIF# VIF(variance inflaion factor)
1/VIF# torelanceまたはlibrary(car)vif(lmオブジェクト名)
あらかじめcarパッケージをインストールしておく必要がある．
ステップワイズ分析
library(MASS)
オブジェクト名 <- stepAIC(lmオブジェクト名)summary(オブジェクト名)
MASSパッケージは最初からインストールされている．

> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 記述統計量> dtmp <- d1[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu work result
stress 245 22.94 5.25
1.00
0.40
-0.34 0.62 0.03
0.44
kyoufu 245 4.05 1.17
0.40
1.00
-0.03 0.31 0.10
0.20
support 245 18.42 4.96 -0.34 -0.03
1.00 -0.51 -0.03 -0.39
utsu
245 20.29 6.49
0.62
0.31
-0.51 1.00 0.02
0.76
work
245 0.50 0.50
0.03
0.10
-0.03 0.02 1.00 -0.08
result 245 0.26 0.44
0.44
0.20
-0.39 0.76 -0.08
1.00>> #偏回帰係数の推定> result.1 <- lm(utsu ~ stress + kyoufu , data=d1)> summary(result.1)
286

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Call:lm(formula = utsu ~ stress + kyoufu, data = d1)
Residuals:
Min
1Q-11.3092 -3.2097

Median-0.0432

3Q
3.1134Max
16.0238

Coefficients:
Estimate Std. Error t value Pr(>|t|)(Intercept) 1.90963
1.58558
1.204
0.230
stress
0.72759
0.06806 10.690<2e-16 ***kyoufu0.416230.305221.364
0.174--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 5.105 on 242 degrees of freedom
Multiple R-squared: 0.387,
Adjusted R-squared: 0.382
F-statistic: 76.4 on 2 and 242 DF, p-value: < 2.2e-16> confint(result.1)
2.5 %
97.5 %(Intercept) -1.2136587 5.0329271
stress
0.5935196 0.8616657
kyoufu-0.1850019 1.0174659>>> #標準偏回帰係数の推定> d2 <- as.data.frame(scale(d1[,c("stress","kyoufu","utsu")]))> #共分散行列の確認> round(cov(d2), 2)
stress kyoufu utsu
stress1.00
0.40 0.62
kyoufu0.40
1.00 0.31
utsu
0.62
0.31 1.00> result.2 <- lm(utsu ~ stress + kyoufu , data=d2)> summary(result.2)
Call:lm(formula = utsu ~ stress + kyoufu, data = d2)
Residuals:
Min
1Q
Median-1.74165 -0.49430 -0.00665

3Q
0.47948Max
2.46771

Coefficients:
Estimate Std. Error t value Pr(>|t|)(Intercept) 1.235e-16 5.023e-02
0.000
1.000
stress
5.880e-01 5.501e-02 10.690<2e-16 ***kyoufu7.502e-02 5.501e-02
1.364
0.174
--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7861 on 242 degrees of freedom
Multiple R-squared: 0.387,
Adjusted R-squared: 0.382
F-statistic: 76.4 on 2 and 242 DF, p-value: < 2.2e-16> confint(result.2)
2.5 %
97.5 %(Intercept) -0.09893404 0.09893404
stress
0.47968584 0.69640299
kyoufu-0.03334233 0.18337482>>> #多重共線性の確認> # carパッケージのvifを使う方法> library(car)> VIF <- vif(result.2)> TOLERANCE <- 1/VIF
287

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> round(data.frame(VIF, TOLERANCE),3)
VIF TOLERANCE
stress 1.195
0.837
kyoufu 1.195
0.837>> # 説明変数だけのデータから計算する方法> d3 <- d1[,c("stress","kyoufu")]> VIF <- diag(solve(cor(d3)))> tolerance <- 1/VIF> data.frame(VIF, tolerance)
VIF tolerance
stress 1.1947 0.8370302
kyoufu 1.1947 0.8370302>>>> #残差プロットなどを描く> #図を4枚同時に並べる指定> par(mfrow=c(2,2))> plot(result.2)> par(mfrow=c(1,1))>>> #ステップワイズ分析> #MASSパッケージの読み込み> library(MASS)> result.3 <- stepAIC(result.2)
Start: AIC=-114.92
utsu ~ stress + kyoufu- kyoufu<none>- stress

Df Sum of Sq
RSS
AIC
1
1.149 150.71 -115.043
149.56 -114.919
1
70.624 220.19 -22.162

Step: AIC=-115.04
utsu ~ stress
Df Sum of Sq
RSS
AIC<none>
150.71 -115.043- stress 1
93.288 244.00
0.998> summary(result.3)
Call:lm(formula = utsu ~ stress, data = d2)
Residuals:
Min
1Q
Median-1.79071 -0.49560 -0.00575

3Q
0.47388

Max
2.41283

Coefficients:
Estimate Std. Error t value Pr(>|t|)(Intercept) 1.448e-16 5.031e-02
0.00
1stress6.183e-01 5.042e-02
12.26<2e-16 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7875 on 243 degrees of freedom
Multiple R-squared: 0.3823,
Adjusted R-squared: 0.3798
F-statistic: 150.4 on 1 and 243 DF, p-value: < 2.2e-16> # 信頼区間> confint(result.3)
2.5 %
97.5 %(Intercept) -0.09910683 0.09910683
stress
0.51901839 0.71763782

288

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

重回帰分析 ― glm関数
オブジェクト名 <- glm(基準変数 ~ 説明変数, family=gaussian, データフレーム名)
summary(オブジェクト名)glm()でモデルを指定し，結果を「オブジェクト名」に保存する．その内容をsummary()で表示する．

> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 記述統計量> dtmp <- d1[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu work result
stress 245 22.94 5.25
1.00
0.40
-0.34 0.62 0.03
0.44
kyoufu 245 4.05 1.17
0.40
1.00
-0.03 0.31 0.10
0.20
support 245 18.42 4.96 -0.34 -0.03
1.00 -0.51 -0.03 -0.39
utsu
245 20.29 6.49
0.62
0.31
-0.51 1.00 0.02
0.76
work
245 0.50 0.50
0.03
0.10
-0.03 0.02 1.00 -0.08
result 245 0.26 0.44
0.44
0.20
-0.39 0.76 -0.08
1.00>> #偏回帰係数の推定> result.1 <- glm(utsu ~ stress + kyoufu + support, family=gaussian, data=d1)> summary(result.1)
Call:glm(formula = utsu ~ stress + kyoufu + support, family = gaussian,data = d1)
Deviance Residuals:
Min
1Q-11.0197-3.3419

Median0.16463Q
3.0142

Max
11.7647

Coefficients:
Estimate Std. Error t value Pr(>|t|)(Intercept) 13.22868
2.14218
6.175 2.78e-09 ***stress
0.557960.06634
8.411 3.61e-15 ***kyoufu0.67134
0.28009
2.397
0.0173 *support-0.45934
0.06424 -7.150 1.03e-11 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for gaussian family taken to be 21.58741)
Null deviance: 10288.0
Residual deviance: 5202.6
AIC: 1453.9

on 244on 241degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 2289

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> confint(result.1)
Waiting for profiling to be done...
2.5 %97.5 %(Intercept) 9.0300832 17.4272733
stress
0.4279414 0.6879808
kyoufu0.1223773 1.2203088
support-0.5852586 -0.3334245>>> #標準偏回帰係数の推定> d2 <- as.data.frame(scale(d1[,c("stress","kyoufu","support","utsu")]))> #共分散行列の確認> round(cov(d2), 2)
stress kyoufu support utsu
stress1.00
0.40-0.34 0.62
kyoufu0.40
1.00-0.03 0.31
support -0.34 -0.03
1.00 -0.51
utsu
0.62
0.31
-0.51 1.00
> result.2 <- glm(utsu ~ stress + kyoufu + support, family=gaussian, data=d2)> summary(result.2)
Call:glm(formula = utsu ~ stress + kyoufu + support, family = gaussian,data = d2)
Deviance Residuals:
Min
1Q-1.69706 -0.51466

Median0.02535

3Q
0.46419Max
1.81181

Coefficients:
Estimate Std. Error t value Pr(>|t|)(Intercept) 7.334e-17 4.571e-02
0.000
1.0000stress
4.509e-01 5.361e-02
8.411 3.61e-15 ***kyoufu1.210e-01 5.048e-02
2.397
0.0173 *support-3.508e-01 4.907e-02 -7.150 1.03e-11 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for gaussian family taken to be 0.5119875)
Null deviance: 244.00
Residual deviance: 123.39
AIC: 537.23

on 244on 241degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 2> confint(result.2)
Waiting for profiling to be done...
2.5 %97.5 %(Intercept) -0.08959726 0.08959726
stress
0.34586463 0.55602983
kyoufu0.02205570 0.21993258
support-0.44701225 -0.25466489
>
>
>
>

290

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

重回帰分析 ― sem関数
パッケージの読み込み
library(sem)モデルの設定specifyEquations を使う方法
モデル名 <- specifyEquations()
予測式
V(変数名.)= 分散，誤差分散を表すパラメタ（または設定値）
C(変数名1, 変数名2)= 共分散表すパラメタ（または設定値）
specifyModel を使う方法
モデル名 <- specifyModel()各パラメタ（または設定値）を設定する式
パラメタ値の推定
semオブジェクト名 <- sem(モデル名, 共分散行列（またはデータ行列）, N=標本サイズ)
summary(semオブジェクト名)
標準化解の推定
stdCoef(semオブジェクト名)
あらかじめsemパッケージをインストールしておく必要がある．
（行をあけると，モデル設定が終了したと判断されてしまう）（逆に，行をあけないと，モデル設定が終了したことにならない）

モデル部分のスクリプトの例（重回帰モデル

x4 = b41 * x1 + b42 * x2 + b43 * x3 + e4）# specifyEquations を使う方法
seq.1 <- specifyEquations()
x4 = b41*x1 + b42*x2 +b43*x3
V(x4) = ev4
V(x1) = v1
V(x2) = v2
V(x3) = v3
C(x1,x2) = c12
C(x1,x3) = c13
C(x2,x3) = c23# 予測式# 内生変数の誤差分散# 外生変数の分散# 外生変数の共分散# specifyModel を使う方法
smd.1 <- specify.model()x4 <- x1, b41, NA
x4 <- x2, b42, NA
x4 <- x3, b43, NA
x4 <-> x4, ev4, NA
x1 <-> x1, v1, NA
x2 <-> x2, v2, NA
x3 <-> x3, v3, NA
x1 <-> x2, c12, NA
x1 <-> x3, c13, NA
x2 <-> x3, c23, NA# 1行目：x4に対するx1の偏回帰係数をb41とする（NAは，「初期値を特に指定しない」の意．以下同様）# 2行目：x4に対するx2の偏回帰係数をb42とする# 3行目：x4に対するx3の偏回帰係数をb43とする# 4行目：x4の誤差分散をev4とする# 5行目：x1の分散をv1とする# 6行目：x2の分散をv2とする# 7行目：x3の分散をv3とする# 8行目：x1とx2の共分散をc12とする# 9行目：x1とx3の共分散をc13とする#10行目：x2とx3の共分散をc23とする

291

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 記述統計量> dtmp <- d1[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu work result
stress 245 22.94 5.25
1.00
0.40
-0.34 0.62 0.03
0.44
kyoufu 245 4.05 1.17
0.40
1.00
-0.03 0.31 0.10
0.20
support 245 18.42 4.96 -0.34 -0.03
1.00 -0.51 -0.03 -0.39
utsu
245 20.29 6.49
0.62
0.31
-0.51 1.00 0.02
0.76
work
245 0.50 0.50
0.03
0.10
-0.03 0.02 1.00 -0.08
result 245 0.26 0.44
0.44
0.20
-0.39 0.76 -0.08
1.00>> #変数名の変更（式を書くのにはこのほうが簡単）> # x1:ストレス x2:失敗恐怖 x3:ソーシャルサポート x4:うつ傾向> colnames(d1) <- c("id", "x1", "x2", "x3", "x4","work","result")> head(d1)
1
2
3
4
5
6
>

id x1 x2 x3 x4 work result
1 20 2.2 17 18
00
2 23 4.8 18 21
10
3 30 5.8 12 29
1
1
4 25 5.2 18 29
01
5 26 2.0 8 22
10
6 21 5.0 26 19
10> # 共分散行列・相関係数行列> cov.d1 <- cov(d1[,c("x1", "x2", "x3", "x4")])> cor.d1 <- cor(d1[,c("x1", "x2", "x3", "x4")])>>>>> #sem パッケージの読み込み> library(sem)>> # 適合度指標出力の指定> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))>>> # 構造方程式モデリング> # x4 = b41 * x1 + b42 * x2 + b43 * x3 + e4>
> # specifyEquations を使う方法> # モデルの設定> seq.1 <- specifyEquations()
1: x4 = b41*x1 + b42*x2 +b43*x3
2: V(x4) = ev4
3: V(x1) = v1
4: V(x2) = v2
5: V(x3) = v3
292

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

6: C(x1,x2) = c12
7: C(x1,x3) = c13
8: C(x2,x3) = c23
9:Read 8 items> # モデルの当てはめ（共分散行列）> sem.seq.1 <- sem(seq.1, cov.d1, N=nrow(d1))> summary(sem.seq.1)
Model Chisquare = 0
Df =Goodness-of-fit index = 1
AIC = 20
AICc = 0.9401709
BIC = 0CAIC = 0
Normalized Residuals
Min.
1st Qu.
-1.861e-15 0.000e+00

0 Pr(>Chisq) = NAMedianMean
0.000e+00 -1.675e-17

3rd Qu.
0.000e+00

Max.
8.713e-16

R-square for Endogenous Variables
x4
0.4943
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b41 0.5579611 0.06592870 8.4630984 2.603658e-17 x4 <--- x1
b42 0.6713431 0.27836253 2.4117582 1.587581e-02 x4 <--- x2
b43 -0.4593416 0.06384842 -7.1942506 6.280474e-13 x4 <--- x3
ev4 21.3219891 1.93040219 11.0453610 2.308379e-28 x4 <--> x4
v1 27.5413182 2.49347379 11.0453610 2.308379e-28 x1 <--> x1
v2
1.3695590 0.12399405 11.0453610 2.308379e-28 x2 <--> x2
v3 24.5971228 2.22691886 11.0453610 2.308379e-28 x3 <--> x3
c12 2.4793409 0.42400604 5.8474189 4.992591e-09 x2 <--> x1
c13 -8.7938274 1.75878193 -4.9999532 5.734423e-07 x3 <--> x1
c23 -0.1549716 0.37169984 -0.4169266 6.767321e-01 x3 <--> x2
Iterations =0>> # 標準化解の表示> (sc.sem.sew.1 <- stdCoef(sem.seq.1))
Std. Estimate
b41 b410.45094723 x4 <--- x1
b42 b420.12099414 x4 <--- x2
b43 b43-0.35083857 x4 <--- x3
ev4 ev4
0.50569259 x4 <--> x4
v1
v1
1.00000000 x1 <--> x1
v2
v2
1.00000000 x2 <--> x2
v3
v3
1.00000000 x3 <--> x3
c12 c120.40369513 x2 <--> x1
c13 c13-0.33786517 x3 <--> x1
c23 c23-0.02670051 x3 <--> x2>> # モデルの当てはめ（相関係数行列）> sem.seq.1 <- sem(seq.1, cor.d1, N=nrow(d1))> summary(sem.seq.1)
Model Chisquare = -5.417888e-14
Goodness-of-fit index = 1
AIC = 20
AICc = 0.9401709
BIC = -5.417888e-14
CAIC = -5.417888e-14
Normalized Residuals
Min.
1st Qu.
-1.475e-15 0.000e+00

Median0.000e+00

Df =0 Pr(>Chisq) = NA

Mean
9.014e-18

3rd Qu.
0.000e+00
293

Max.
1.547e-15

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

R-square for Endogenous Variables
x4
0.4943
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b41 0.45094723 0.05328394 8.4630984 2.603658e-17 x4 <--- x1
b42 0.12099414 0.05016844 2.4117582 1.587581e-02 x4 <--- x2
b43 -0.35083857 0.04876652 -7.1942506 6.280474e-13 x4 <--- x3
ev4 0.50569259 0.04578326 11.0453610 2.308379e-28 x4 <--> x4
v1
1.00000000 0.09053575 11.0453610 2.308379e-28 x1 <--> x1
v2
1.00000000 0.09053575 11.0453610 2.308379e-28 x2 <--> x2
v3
1.00000000 0.09053575 11.0453610 2.308379e-28 x3 <--> x3
c12 0.40369513 0.06903817 5.8474189 4.992591e-09 x2 <--> x1
c13 -0.33786517 0.06757367 -4.9999532 5.734423e-07 x3 <--> x1
c23 -0.02670051 0.06404126 -0.4169266 6.767321e-01 x3 <--> x2
Iterations =0> (sc.sem.seq.1 <- stdCoef(sem.seq.1))
Std. Estimate
b41 b410.45094723 x4 <--- x1
b42 b420.12099414 x4 <--- x2
b43 b43-0.35083857 x4 <--- x3
ev4 ev4
0.50569259 x4 <--> x4
v1
v1
1.00000000 x1 <--> x1
v2
v2
1.00000000 x2 <--> x2
v3
v3
1.00000000 x3 <--> x3
c12 c120.40369513 x2 <--> x1
c13 c13-0.33786517 x3 <--> x1
c23 c23-0.02670051 x3 <--> x2>> # specifyModel を使う方法> # モデルの設定> smd.1 <- specifyModel()1: x4 <- x1, b41, NA
2: x4 <- x2, b42, NA
3: x4 <- x3, b43, NA
4: x4 <-> x4, ev4, NA
5: x1 <-> x1, v1,NA
6: x2 <-> x2, v2, NA
7: x3 <-> x3, v3, NA
8: x1 <-> x2, c12, NA
9: x1 <-> x3, c13, NA
10: x2 <-> x3, c23, NA
11:
Read 10 records
NOTE: it is generally simpler to use specifyEquations() or cfa()
see ?specifyEquations> # モデルの当てはめ（相関係数行列）> sem.smd.1 <- sem(smd.1, cor.d1, N=nrow(d1))> summary(sem.smd.1)
Model Chisquare = -5.417888e-14
Goodness-of-fit index = 1
AIC = 20
AICc = 0.9401709
BIC = -5.417888e-14
CAIC = -5.417888e-14
Normalized Residuals
Min.
1st Qu.
-1.475e-15 0.000e+00

Median0.000e+00

Df =0 Pr(>Chisq) = NA

Mean
9.014e-18

3rd Qu.
0.000e+00

R-square for Endogenous Variables
x4
0.4943294

Max.
1.547e-15

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b41 0.45094723 0.05328394 8.4630984 2.603658e-17 x4 <--- x1
b42 0.12099414 0.05016844 2.4117582 1.587581e-02 x4 <--- x2
b43 -0.35083857 0.04876652 -7.1942506 6.280474e-13 x4 <--- x3
ev4 0.50569259 0.04578326 11.0453610 2.308379e-28 x4 <--> x4
v1
1.00000000 0.09053575 11.0453610 2.308379e-28 x1 <--> x1
v2
1.00000000 0.09053575 11.0453610 2.308379e-28 x2 <--> x2
v3
1.00000000 0.09053575 11.0453610 2.308379e-28 x3 <--> x3
c12 0.40369513 0.06903817 5.8474189 4.992591e-09 x2 <--> x1
c13 -0.33786517 0.06757367 -4.9999532 5.734423e-07 x3 <--> x1
c23 -0.02670051 0.06404126 -0.4169266 6.767321e-01 x3 <--> x2
Iterations =0> (sc.sem.smd.1 <- stdCoef(sem.smd.1))
Std. Estimate
b41 b410.45094723 x4 <--- x1
b42 b420.12099414 x4 <--- x2
b43 b43-0.35083857 x4 <--- x3
ev4 ev4
0.50569259 x4 <--> x4
v1
v1
1.00000000 x1 <--> x1
v2
v2
1.00000000 x2 <--> x2
v3
v3
1.00000000 x3 <--> x3
c12 c120.40369513 x2 <--> x1
c13 c13-0.33786517 x3 <--> x1
c23 c23-0.02670051 x3 <--> x2

295

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

主成分得点を用いた重回帰分析
重回帰分析において，説明変数間の相関が高いときに，無相関ないくつかの主成分を説明変数にして，重回帰分析を行う．説明変数が無相関になるという利点がある．
この方法と，「主成分回帰分析」と言われるものとは，解釈するものが異なる．主成分回帰分析では，いく
つかの主成分を採用したとき，結局もとの変数がどう基準変数に影響するかを解釈する．つまり，もとの説
明変数に対する回帰係数を解釈する．これに対し，主成分得点を用いた回帰分析では，もとの説明変数ではなく，主成分得点がどう基準変数に影響するかに関心があり，主成分得点に対する回帰係数を解釈する．
具体的な手続きには，説明変数を主成分分析して主成分得点を求め，それを説明変数にして重回帰分析を行う．
回帰分析
lm，glm，semのいずれを用いてもよい
主成分分析
library(psych)
オブジェクト名 <- principal(データ名, nfactors=主成分数, rotate="none")print(オブジェクト名)
スコア名 <- オブジェクト名$scores
あらかじめpsychパッケージをインストールしておく必要がある．
主成分数は変数数以下にする．

> setwd("d:\\")> d1 <- read.table("サポートデータ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)support_s support_p kenkou
1
17
13
23
2
16
19
22
3
22
22
29
4
14
17
19
5
18
17
26
6
14
15
22
>
>
> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD support_s support_p kenkou
support_s 250 14.99 3.04
1.00
0.38
0.66
support_p 250 14.99 3.03
0.38
1.00
0.02
kenkou250 20.00 5.01
0.66
0.02
1.00
>
>
>
> #標準偏回帰係数の推定> d2 <- as.data.frame(scale(d1[,c("support_s","support_p","kenkou")]))> #共分散行列の確認> round(cov(d2), 2)
support_s support_p kenkou
support_s
1.00
0.38
0.66
support_p
0.38
1.00
0.02
kenkou
0.66
0.02
1.00
> result.2 <- lm(kenkou ~ support_s + support_p , data=d2)> summary(result.2)
Call:lm(formula = kenkou ~ support_s + support_p, data = d2)
296

名古屋 大学
Residuals:
Min
1Q-1.87478 -0.43616

Median0.05371

3Q
0.50240

大 学院 教育発 達科 学研 究科・ 教育 学部

Max
1.79567

Coefficients:

Estimate Std. Error t value Pr(>|t|)(Intercept) 8.444e-17 4.467e-02
0.000
1
support_s
7.675e-01 4.835e-02 15.872 < 2e-16 ***support_p-2.718e-01 4.835e-02 -5.621 5.11e-08 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7063 on 247 degrees of freedom
Multiple R-squared: 0.5051,
Adjusted R-squared: 0.5011
F-statistic: 126.1 on 2 and 247 DF, p-value: < 2.2e-16> confint(result.2)
2.5 %
97.5 %(Intercept) -0.08798634 0.08798634
support_s
0.67226113 0.86274015
support_p-0.36705158 -0.17657255>>>>> # 説明変数の抽出> d3 <- d2[,c("support_s","support_p")]>>>> #主成分分析の実行> # psychパッケージの読み込み> library(psych)> prin.1 <- principal(d3, nfactors=2, rotate="none", scores=TRUE)> print(prin.1)
Principal Components Analysis
Call: principal(r = d3, nfactors = 2, rotate = "none", scores = TRUE)
Standardized loadings (pattern matrix) based upon correlation matrix
PC1
PC2 h2u2 comsupport_s 0.83 -0.56 1 2.2e-16 1.7
support_p 0.83 0.56 1 2.2e-16 1.7
PC1 PC2
SS loadings
1.38 0.62
Proportion Var
0.69 0.31
Cumulative Var
0.69 1.00
Proportion Explained 0.69 0.31
Cumulative Proportion 0.69 1.00
Mean item complexity = 1.7
Test of the hypothesis that 2 components are sufficient.
The root mean square of the residuals (RMSR) is 0with the empirical chi square 0 with prob < NA
Fit based upon off diagonal values = 1#> 主成分得点> dPC <- prin.1$scores> head(dPC)PC1
PC2[1,] 0.002829912 -1.182324397[2,] 0.996054277 0.887391725[3,] 2.782506917 0.001807549[4,] 0.201959837 0.886875872[5,] 0.995707811 -0.294934736[6,] -0.195260616 0.295454715>
297

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 主成分得点を説明変数にしたデータの作成> d4 <- data.frame(dPC,d2[,"kenkou"])> colnames(d4) <- c("pc1","pc2","kenkou")>>> # 記述統計量> dtmp <- d4> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean SD pc1
pc2 kenkou
pc1
250
0 1 1.00 0.00
0.41
# 主成分得点間の相関は0になっている．
pc2
250
0 1 0.00 1.00 -0.58
kenkou 250
0 1 0.41 -0.58
1.00>>> # 主成分得点を用いた回帰分析> res3 <- lm(kenkou~pc1+pc2, data=d4)> summary(res3)Call:lm(formula = kenkou ~ pc1 + pc2, data = d4)
Residuals:
Min
1Q-1.87478 -0.43616

Median0.05371

3Q
0.50240Max
1.79567

Coefficients:

Estimate Std. Error t value Pr(>|t|)(Intercept) 1.176e-18 4.467e-02
0.000
1
pc1
4.115e-01 4.476e-02
9.193<2e-16 ***pc2-5.795e-01 4.476e-02 -12.946<2e-16 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7063 on 247 degrees of freedom
Multiple R-squared: 0.5051,
Adjusted R-squared: 0.5011
F-statistic: 126.1 on 2 and 247 DF, p-value: < 2.2e-16
>
>

298

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

パス解析 ― specifyEquations関数
パッケージの読み込み
library(sem)適合度指標の設定
opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデルの設定モデル名 <- specifyEquations()
予測式
V(変数名.)= 分散，誤差分散を表すパラメタ（または設定値）
C(変数名1, 変数名2)= 共分散表すパラメタ（または設定値）
パラメタ値の推定
semオブジェクト名 <- sem(モデル名, 共分散行列（またはデータ行列）, N=標本サイズ)
summary(semオブジェクト名)
標準化解の推定
stdCoef(semオブジェクト名)
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）

モデル部分のスクリプトの例
パスモデル１x1 = b12 * x2 + b13 * x3 + e1
x4 = b41 * x1 + b43 * x3 + e4

seq.1 <- specifyEquations()
x1 = b12*x2 + b13*x3x4 = b41*x1 + b43*x3
V(x1) = ev1
V(x4) = ev4
V(x2) = v2
V(x3) = v3
C(x2,x3) = c23

パスモデル２# x1についての回帰式# x4についての回帰式# 予測式# 内生変数の誤差分散# 外生変数の分散# 外生変数の共分散パスモデル１において，x2 と x3 の共分散を0と固定するモデル．

seq.1 <- specifyEquations()
x1 = b12*x2 + b13*x3x4 = b41*x1 + b43*x3
V(x1) = ev1
V(x4) = ev4
V(x2) = v2
V(x3) = v3
C(x2,x3) = 0# 予測式# 内生変数の誤差分散# 外生変数の分散# 外生変数の共分散299

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 記述統計量> dtmp <- d1[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu work result
stress 245 22.94 5.25
1.00
0.40
-0.34 0.62 0.03
0.44
kyoufu 245 4.05 1.17
0.40
1.00
-0.03 0.31 0.10
0.20
support 245 18.42 4.96 -0.34 -0.03
1.00 -0.51 -0.03 -0.39
utsu
245 20.29 6.49
0.62
0.31
-0.51 1.00 0.02
0.76
work
245 0.50 0.50
0.03
0.10
-0.03 0.02 1.00 -0.08
result 245 0.26 0.44
0.44
0.20
-0.39 0.76 -0.08
1.00>> #変数名の変更（式を書くのにはこのほうが簡単）> # x1:ストレス x2:失敗恐怖 x3:ソーシャルサポート x4:うつ傾向> colnames(d1) <- c("id", "x1", "x2", "x3", "x4","work","result")> head(d1)
id x1 x2 x3 x4 work result
1 1 20 2.2 17 18
00
2 2 23 4.8 18 21
10
3 3 30 5.8 12 29
11
4 4 25 5.2 18 29
01
5 5 26 2.0 8 2210
6 6 21 5.0 26 19
10>> # 共分散行列・相関係数行列> cov.d1 <- cov(d1[,c("x1", "x2", "x3", "x4")])> cor.d1 <- cor(d1[,c("x1", "x2", "x3", "x4")])>>> #sem パッケージの読み込み> library(sem)>> # 適合度指標出力の指定> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))>>> # モデルの設定> # specifyEquations を使う方法> seq.1 <- specifyEquations()
1: x1 = b12*x2 + b13*x3
2: x4 = b41*x1 + b43*x3
3: V(x1) = ev1
4: V(x4) = ev4
5: V(x2) = v2
6: V(x3) = v3
7: C(x2,x3) = c23
8:
Read 7 items300

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 標準化解の推定> sem.seq.1s <- sem(seq.1, cor.d1, N=nrow(d1))> summary(sem.seq.1s)
Model Chisquare = 5.748331
Df = 1 Pr(>Chisq) = 0.01650433
Goodness-of-fit index = 0.9884923
Adjusted goodness-of-fit index = 0.8849227
RMSEA index = 0.1395004
90% CI: (0.0476635, 0.2587895)
Bentler-Bonett NFI = 0.9763773
Tucker-Lewis NNFI = 0.8799611
Bentler CFI = 0.9799935
Bentler RNI = 0.9799935
Bollen IFI = 0.9804063
SRMR = 0.03150648
AIC = 23.74833
AICc = 6.514288
BIC = 0.2470727
CAIC = -0.7529273
Normalized Residuals
Min. 1st Qu. Median
0.0000 0.0000 0.0000

Mean 3rd Qu.
0.1903 0.0000

Max.
1.5220R-square for Endogenous Variables
x1
x4
0.2700 0.4823
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12 0.39495553 0.05471571 7.2183210 5.263335e-13 x1 <--- x2
b13 -0.32731966 0.05471571 -5.9821884 2.201594e-09 x1 <--- x3
b41 0.50485409 0.04894234 10.3152836 6.010359e-25 x4 <--- x1
b43 -0.33585592 0.04894234 -6.8622780 6.777099e-12 x4 <--- x3
ev1 0.72996847 0.06608824 11.0453610 2.308379e-28 x1 <--> x1
ev4 0.51774751 0.04687466 11.0453610 2.308379e-28 x4 <--> x4
v2
1.00000000 0.09053575 11.0453610 2.308379e-28 x2 <--> x2
v3
1.00000000 0.09053575 11.0453610 2.308379e-28 x3 <--> x3
c23 -0.02670051 0.06404126 -0.4169266 6.767321e-01 x3 <--> x2
Iterations = 0>>> stdCoef(sem.seq.1s)
Std. Estimate
b12 b120.39495553 x1 <--- x2
b13 b13-0.32731966 x1 <--- x3
b41 b410.50485409 x4 <--- x1
b43 b43-0.33585592 x4 <--- x3
ev1 ev1
0.72996847 x1 <--> x1
ev4 ev4
0.51774751 x4 <--> x4
v2
v2
1.00000000 x2 <--> x2
v3
v3
1.00000000 x3 <--> x3
c23 c23-0.02670051 x3 <--> x2

e 1 0.73
1.00

X 2 失敗恐怖
-0.03
1.00

X 3 ソーシャルサポート>>> # x1とx2の共分散を0に固定するモデル> seq.2 <- specifyEquations()
1: x1 = b12*x2 + b13*x3
2: x4 = b41*x1 + b43*x3
3: V(x1) = ev1
4: V(x4) = ev4
5: V(x2) = v2
6: V(x3) = v3
7: C(x2,x3) = 0
8:
Read 7 items

301

b 12
0.39

b 13
-0.33

e 4 0.52

R2=0.27b 41
0.50

X 1 ストレス

R2=0.48

X 4 うつ傾向

b 43
-0.34
X2=5.75, df=1, p=0.017,
AGFI=0.88, RMSEA=0.14,CFI=0.98

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 標準化解の推定> sem.seq.2 <- sem(seq.2, cor.d1, N=nrow(d1))> summary(sem.seq.2)
Model Chisquare = 5.922345
Df = 2 Pr(>Chisq) = 0.0517582
Goodness-of-fit index = 0.9881508
Adjusted goodness-of-fit index = 0.9407539
RMSEA index = 0.08965262
90% CI: (NA, 0.1772158)
Bentler-Bonett NFI = 0.9756622
Tucker-Lewis NNFI = 0.9504211
Bentler CFI = 0.9834737
Bentler RNI = 0.9834737
Bollen IFI = 0.9837476
SRMR = 0.03718342
AIC = 21.92234
AICc = 6.532514
BIC = -5.080172
CAIC = -7.080172
Normalized Residuals
Min. 1st Qu.
Median-0.41710 -0.09514 0.02963

Mean
0.17210

3rd Qu.
0.10240Max.
1.73600

R-square for Endogenous Variables
x1
x4
0.2650 0.4795
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12 0.3949555 0.05469620 7.220895 5.164635e-13 x1 <--- x2
b13 -0.3273197 0.05469620 -5.984322 2.172932e-09 x1 <--- x3
b41 0.5048541 0.04893927 10.315931 5.969982e-25 x4 <--- x1
b43 -0.3358559 0.04877005 -6.886520 5.717353e-12 x4 <--- x3
ev1 0.7299685 0.06608824 11.045361 2.308379e-28 x1 <--> x1
ev4 0.5177475 0.04687466 11.045361 2.308379e-28 x4 <--> x4
v2
1.0000000 0.09053575 11.045361 2.308379e-28 x2 <--> x2
v3
1.0000000 0.09053575 11.045361 2.308379e-28 x3 <--> x3
Iterations = 0>>> stdCoef(sem.seq.2)
Std. Estimate
b12 b120.3963259 x1 <--- x2
b13 b13-0.3284554 x1 <--- x3
b41 b410.5044561 x4 <--- x1
b43 b43-0.3367555 x4 <--- x3
ev1 ev1
0.7350428 x1 <--> x1
ev4 ev40.5205249 x4 <--> x4
v2
v2
1.0000000 x2 <--> x2
v3
v3
1.0000000 x3 <--> x3
0.0000000 x3 <--> x2
>
>
>

302

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

パス解析 ― specifyModel関数
パッケージの読み込み
library(sem)適合度指標の設定
opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデルの設定モデル名 <- specifyModel()各パラメタ（または設定値）を設定する式
パラメタ値の推定
semオブジェクト名 <- sem(モデル名, 共分散行列（またはデータ行列）, N=標本サイズ)
summary(semオブジェクト名)
標準化解の推定
stdCoef(semオブジェクト名)
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）

モデル部分のスクリプトの例
パスモデル１x1 = b12 * x2 + b13 * x3 + e1
x4 = b41 * x1 + b43 * x3 + e4

# x1についての回帰式# x4についての回帰式

model.1 <- specifyModel()x1 <- x2, b12, NA
x1 <- x3, b13, NA
x4 <- x1, b41, NA
x4 <- x3, b43, NA
x1 <-> x1, ev1, NA
x4 <-> x4, ev4, NA
x2 <-> x2, v2, NA
x3 <-> x3, v3, NA
x2 <-> x3, c23, NA# 1行目：x1に対するx2の偏回帰係数をb12とする（NAは，初期値を特に指定しないの意．以下同様）# 2行目：x1に対するx3の偏回帰係数をb13とする# 3行目：x4に対するx1の偏回帰係数をb41とする# 4行目：x4に対するx3の偏回帰係数をb43とする# 5行目：x1の誤差分散をev1とする# 6行目：x4の誤差分散をev4とする# 7行目：x2の分散をv2とする# 8行目：x3の分散をv3とする# 9行目：x2とx3の共分散をc12とする

パスモデル２

パスモデル１において，x2 と x3 の共分散を0と固定するモデル．

model.2 <- specifyModel()x1 <- x2, b12, NA
x1 <- x3, b13, NA
x4 <- x1, b41, NA
x4 <- x3, b43, NA
x1 <-> x1, ev1, NA
x4 <-> x4, ev4, NA
x2 <-> x2, v2, NA
x3 <-> x3, v3, NA# x2 <-> x3, c23, NA を削除# x2 <-> x3, NA, 0 と指定しても同じ
303

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 記述統計量> dtmp <- d1[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu work result
stress 245 22.94 5.25
1.00
0.40
-0.34 0.62 0.03
0.44
kyoufu 245 4.05 1.17
0.40
1.00
-0.03 0.31 0.10
0.20
support 245 18.42 4.96 -0.34 -0.03
1.00 -0.51 -0.03 -0.39
utsu
245 20.29 6.49
0.62
0.31
-0.51 1.00 0.02
0.76
work
245 0.50 0.50
0.03
0.10
-0.03 0.02 1.00 -0.08
result 245 0.26 0.44
0.44
0.20
-0.39 0.76 -0.08
1.00>> #変数名の変更（式を書くのにはこのほうが簡単）> # x1:ストレス x2:失敗恐怖 x3:ソーシャルサポート x4:うつ傾向> colnames(d1) <- c("id", "x1", "x2", "x3", "x4","work","result")> head(d1)
id x1 x2 x3 x4 work result
1 1 20 2.2 17 18
00
2 2 23 4.8 18 21
10
3 3 30 5.8 12 29
11
4 4 25 5.2 18 29
01
5 5 26 2.0 8 2210
6 6 21 5.0 26 19
10>> # 共分散行列・相関係数行列> cov.d1 <- cov(d1[,c("x1", "x2", "x3", "x4")])> cor.d1 <- cor(d1[,c("x1", "x2", "x3", "x4")])>>> #sem パッケージの読み込み> library(sem)>> # 適合度指標出力の指定> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))>> # モデルの設定> # specifyModel を使う方法> smd.1 <- specifyModel()1: x1 <- x2, b12, NA
2: x1 <- x3, b13, NA
3: x4 <- x1, b41, NA
4: x4 <- x3, b43, NA
5: x1 <-> x1, ev1, NA
6: x4 <-> x4, ev4, NA
7: x2 <-> x2, v2, NA
8: x3 <-> x3, v3, NA
9: x2 <-> x3, c23, NA
304

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

10:
Read 9 records
NOTE: it is generally simpler to use specifyEquations() or cfa()
see ?specifyEquations> # 標準化解の推定> sem.smd.1 <- sem(smd.1, cor.d1, N=nrow(d1))> summary(sem.smd.1)
Model Chisquare = 5.748331
Df = 1 Pr(>Chisq) = 0.01650433
Goodness-of-fit index = 0.9884923
Adjusted goodness-of-fit index = 0.8849227
RMSEA index = 0.1395004
90% CI: (0.0476635, 0.2587895)
Bentler-Bonett NFI = 0.9763773
Tucker-Lewis NNFI = 0.8799611
Bentler CFI = 0.9799935
Bentler RNI = 0.9799935
Bollen IFI = 0.9804063
SRMR = 0.03150648
AIC = 23.74833
AICc = 6.514288
BIC = 0.2470727
CAIC = -0.7529273
Normalized Residuals
Min. 1st Qu. Median
0.0000 0.0000 0.0000

Mean 3rd Qu.
0.1903 0.0000

Max.
1.5220R-square for Endogenous Variables
x1
x4
0.2700 0.4823
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12 0.39495553 0.05471571 7.2183210 5.263335e-13 x1 <--- x2
b13 -0.32731966 0.05471571 -5.9821884 2.201594e-09 x1 <--- x3
b41 0.50485409 0.04894234 10.3152836 6.010359e-25 x4 <--- x1
b43 -0.33585592 0.04894234 -6.8622780 6.777099e-12 x4 <--- x3
ev1 0.72996847 0.06608824 11.0453610 2.308379e-28 x1 <--> x1
ev4 0.51774751 0.04687466 11.0453610 2.308379e-28 x4 <--> x4
v2
1.00000000 0.09053575 11.0453610 2.308379e-28 x2 <--> x2
v3
1.00000000 0.09053575 11.0453610 2.308379e-28 x3 <--> x3
c23 -0.02670051 0.06404126 -0.4169266 6.767321e-01 x3 <--> x2
Iterations = 0>> stdCoef(sem.seq.1)
Std. Estimate
10.4373010 x1 <--- f12
b2
0.6293252 x2 <--- f1
3
b3
0.3688269 x3 <--- f1
4
0.6154132 x7 <--- f3
5
b8
0.3753166 x8 <--- f3
6
b9
0.4116027 x9 <--- f37
a31
0.5232285 f3 <--- f1
8
ev1
0.8087679 x1 <--> x1
9ev2
0.6039498 x2 <--> x2
10 ev30.8639667 x3 <--> x3
11 ev70.6212666 x7 <--> x7
12 ev80.8591374 x8 <--> x8
13 ev90.8305832 x9 <--> x9
14 evf3
0.7262319 f3 <--> f3
15 vf11.0000000 f1 <--> f1>>

e 1 0.73
1.00

X 2 失敗恐怖
-0.03
1.00

X 3 ソーシャルサポート> # x1とx2の共分散を0に固定するモデル> smd.2 <- specifyModel()1: x1 <- x2, b12, NA
2: x1 <- x3, b13, NA
305

b 12
0.39

b 13
-0.33

e 4 0.52

R2=0.27b 41
0.50

X 1 ストレス

R2=0.48

X 4 うつ傾向

b 43
-0.34
X2=5.75, df=1, p=0.017,
AGFI=0.88, RMSEA=0.14,CFI=0.98

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

3: x4 <- x1, b41, NA
4: x4 <- x3, b43, NA
5: x1 <-> x1, ev1, NA
6: x4 <-> x4, ev4, NA
7: x2 <-> x2, v2, NA
8: x3 <-> x3, v3, NA
9:Read 8 records
NOTE: it is generally simpler to use specifyEquations() or cfa()
see ?specifyEquations> # 標準化解の推定> sem.smd.2 <- sem(smd.2, cor.d1, N=nrow(d1))> summary(sem.smd.2)
Model Chisquare = 5.922345
Df = 2 Pr(>Chisq) = 0.0517582
Goodness-of-fit index = 0.9881508
Adjusted goodness-of-fit index = 0.9407539
RMSEA index = 0.08965262
90% CI: (NA, 0.1772158)
Bentler-Bonett NFI = 0.9756622
Tucker-Lewis NNFI = 0.9504211
Bentler CFI = 0.9834737
Bentler RNI = 0.9834737
Bollen IFI = 0.9837476
SRMR = 0.03718342
AIC = 21.92234
AICc = 6.532514
BIC = -5.080172
CAIC = -7.080172
Normalized Residuals
Min. 1st Qu.
Median-0.41710 -0.09514 0.02963

Mean
0.17210

3rd Qu.
0.10240Max.
1.73600

R-square for Endogenous Variables
x1
x4
0.2650 0.4795
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12 0.3949555 0.05469620 7.220895 5.164635e-13 x1 <--- x2
b13 -0.3273197 0.05469620 -5.984322 2.172932e-09 x1 <--- x3
b41 0.5048541 0.04893927 10.315931 5.969982e-25 x4 <--- x1
b43 -0.3358559 0.04877005 -6.886520 5.717353e-12 x4 <--- x3
ev1 0.7299685 0.06608824 11.045361 2.308379e-28 x1 <--> x1
ev4 0.5177475 0.04687466 11.045361 2.308379e-28 x4 <--> x4
v2
1.0000000 0.09053575 11.045361 2.308379e-28 x2 <--> x2
v3
1.0000000 0.09053575 11.045361 2.308379e-28 x3 <--> x3
Iterations =0> stdCoef(sem.smd.2)
Std. Estimate
b12 b120.3963259 x1 <--- x2
b13 b13-0.3284554 x1 <--- x3
b41 b410.5044561 x4 <--- x1
b43 b43-0.3367555 x4 <--- x3
ev1 ev1
0.7350428 x1 <--> x1
ev4 ev40.5205249 x4 <--> x4
v2
v2
1.0000000 x2 <--> x2
v3
v3
1.0000000 x3 <--> x3
>
>

306

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多母集団のパス解析 ― specifyEquations関数
library(sem)opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデル名1 <- specifyEquations()
構造方程式
モデル名2 <- specifyEquations()
構造方程式…
群分け変数名 <- factor(群分け変数名)
mgオブジェクト名 <- multigroupModel(モデル名1, モデル名2, …, groups=levels(群分け変数名))
semオブジェクト名 <- sem(mgオブジェクト名, data=データ行列, group="群分け変数")
summary(semオブジェクト名)
stdCoef(semオブジェクト名)
群分け変数名に「group」を用いると不具合が生じることがあるので他の名前を使う
群分け変数のfactor化で，levels=c(水準1,水準2,…), labels=c(ラベル1,ラベル2,…) を設定してもよい
各群のモデルで，同じパラメタ名にすると等値制約になる
群分け変数名はfactor関数を使ってfactor化しておかなければならない
等値制約を加える場合は，例えば，b12.1 と b12.2 をともに b12というパラメタ名にすると，両群に共通な b12 というパラメタ値を推定する
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 群別データ> d11 <- d1[d1$work==1, colnames(d1) %in% c("work")==F]> d10 <- d1[d1$work==0, colnames(d1) %in% c("work")==F]>>> # 記述統計量> dtmp <- d11[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu result
stress 122 23.10 5.08
1.00
0.35
-0.17 0.53
0.33
kyoufu 122 4.17 1.20
0.35
1.00
0.14 0.27
0.17
support 122 18.25 4.56 -0.17
0.14
1.00 -0.38 -0.31
utsu
122 20.44 5.49
0.53
0.27
-0.38 1.00
0.75
result 122 0.22 0.42
0.33
0.17
-0.31 0.75
1.00
>
307

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> dtmp <- d10[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu result
stress 123 22.78 5.43
1.00
0.46
-0.47 0.69
0.54
kyoufu 123 3.93 1.13
0.46
1.00
-0.17 0.35
0.25
support 123 18.59 5.34 -0.47 -0.17
1.00 -0.59 -0.45
utsu
123 20.13 7.38
0.69
0.35
-0.59 1.00
0.79
result 123 0.29 0.46
0.54
0.25
-0.45 0.79
1.00>>
> #変数名の変更（式を書くのにはこのほうが簡単）> # x1:ストレス x2:失敗恐怖 x3:ソーシャルサポート x4:うつ傾向> colnames(d1) <- c("id", "x1", "x2", "x3", "x4","work","result")> head(d1)
id x1 x2 x3 x4 work result
1 1 20 2.2 17 18
00
2 2 23 4.8 18 21
10
3 3 30 5.8 12 29
11
4 4 25 5.2 18 29
01
5 5 26 2.0 8 2210
6 6 21 5.0 26 19
1
0
>
>
>
> #sem パッケージの読み込み> library(sem)>> # 適合度指標出力の指定> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))>>> # モデルの設定> # specifyEquations を使う方法>> seq.1 <- specifyEquations()
1: x1 = b12.1*x2 + b13.1*x3
2: x4 = b41.1*x1 + b43.1*x3
3: V(x1) = ev1.1
4: V(x4) = ev4.1
5: V(x2) = v2.1
6: V(x3) = v3.1
7: C(x2,x3) = c23.1
8:
Read 7 items> seq.2 <- specifyEquations()
1: x1 = b12.2*x2 + b13.2*x3
2: x4 = b41.2*x1 + b43.2*x3
3: V(x1) = ev1.2
4: V(x4) = ev4.2
5: V(x2) = v2.2
6: V(x3) = v3.2
7: C(x2,x3) = c23.2
8:
Read 7 items> # 多母集団分析> d1$work <- factor(d1$work)> mg.seq <- multigroupModel(seq.1, seq.2, groups=levels(d1$work))> sem.mg.seq <- sem(mg.seq, data=d1, group="work")> summary(sem.mg.seq)308名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Model Chisquare = 6.042957 Df = 2 Pr(>Chisq) = 0.04872913
Chisquare (null model) = 246.2831 Df = 12
Goodness-of-fit index = 0.9880118
Adjusted goodness-of-fit index = 0.9040942
RMSEA index = 0.1289871 90% CI: (0.008417286, 0.2528073)
Bentler-Bonett NFI = 0.9754634
Tucker-Lewis NNFI = 0.8964597
Bentler CFI = 0.9827433
Bentler RNI = 0.9827433
Bollen IFI = 0.9834497
SRMR = 0.0314776
AIC = 42.04296
AICc = 9.069505
BIC = -4.95956
Iterations: initial fits, 0 0

final fit, 0

work: 0Model Chisquare = 0.9026323
Df = 1 Pr(>Chisq) = 0.3420769
Goodness-of-fit index = 0.9963279
Adjusted goodness-of-fit index = 0.9632787
RMSEA index = 0
90% CI: (NA, 0.23476)
Bentler-Bonett NFI = 0.9944273
Tucker-Lewis NNFI = 1.003746
Bentler CFI = 1
Bentler RNI = 1.000624
Bollen IFI = 1.000605
SRMR = 0.01590207
AIC = 18.90263
AICc = 2.495553
BIC = -3.909552
CAIC = -4.909552
Normalized Residuals
Min. 1st Qu. Median
0.0000 0.0000 0.0000

Mean 3rd Qu.
0.0665 0.0000

Max.
0.5320R-square for Endogenous Variables
x1
x4
0.3704 0.5634
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12.1 1.8791914 0.34991236 5.370463 7.853478e-08 x1 <--- x2
b13.1 -0.4114030 0.07410181 -5.551862 2.826424e-08 x1 <--- x3
b41.1 0.7164477 0.09212589 7.776834 7.436204e-15 x4 <--- x1
b43.1 -0.4709965 0.09366555 -5.028493 4.943508e-07 x4 <--- x3
ev1.1 18.5541031 2.37560947 7.810250 5.707481e-15 x1 <--> x1
ev4.1 23.7533710 3.04130751 7.810250 5.707481e-15 x4 <--> x4
v2.1
1.2784699 0.16369130 7.810250 5.707481e-15 x2 <--> x2
v3.1 28.5069972 3.64994698 7.810250 5.707481e-15 x3 <--> x3
c23.1 -1.0180328 0.55428088 -1.836673 6.625817e-02 x3 <--> x2
work: 1Model Chisquare = 5.140324
Df = 1 Pr(>Chisq) = 0.02337628
Goodness-of-fit index = 0.9796275
Adjusted goodness-of-fit index = 0.7962752
RMSEA index = 0.1849799
90% CI: (0.05473528, 0.3556438)
Bentler-Bonett NFI = 0.9390293
Tucker-Lewis NNFI = 0.6827666
Bentler CFI = 0.9471278
Bentler RNI = 0.9471278
Bollen IFI = 0.9503011
SRMR = 0.04718079
AIC = 23.14032
AICc = 6.747467
BIC = 0.3363034
CAIC = -0.6636966
309

名古屋 大学
Normalized Residuals
Min. 1st Qu. Median
0.0000 0.0000 0.0000

Mean 3rd Qu.
0.2036 0.0000

大 学院 教育発 達科 学研 究科・ 教育 学部

Max.
1.6286R-square for Endogenous Variablesx1
x4
0.1685 0.3628
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12.2 1.5940497 0.35351596 4.509131 6.509380e-06 x1 <--- x2
b13.2 -0.2464606 0.09316002 -2.645562 8.155534e-03 x1 <--- x3
b41.2 0.5150020 0.07959184 6.470538 9.765471e-11 x4 <--- x1
b43.2 -0.3567843 0.08859546 -4.027118 5.646481e-05 x4 <--- x3
ev1.2 21.4329344 2.75552240 7.778175 7.357848e-15 x1 <--> x1
ev4.2 19.1893399 2.46707498 7.778175 7.357848e-15 x4 <--> x4
v2.2
1.4446416 0.18573016 7.778175 7.357848e-15 x2 <--> x2
v3.2 20.8026690 2.67449242 7.778175 7.357848e-15 x3 <--> x3
c23.2 0.7534345 0.50304910 1.497736 1.342020e-01 x3 <--> x2> stdCoef(sem.mg.seq)
Group:

0
Std. Estimate
1 b12.1
0.3914194 x1 <--- x2
2 b13.1-0.4046404 x1 <--- x3
3 b41.1
0.5272571 x4 <--- x1
4 b43.1-0.3409239 x4 <--- x3
5 ev1.1
0.6296396 x1 <--> x1
6 ev4.1
0.4365693 x4 <--> x4
7 v2.11.0000000 x2 <--> x2
8 v3.11.0000000 x3 <--> x3
9 c23.1-0.1686323 x3 <--> x2
Group:

1
Std. Estimate
1 b12.2
0.3773805 x1 <--- x2
2 b13.2-0.2214137 x1 <--- x3
3 b41.2
0.4764409 x4 <--- x1
4 b43.2-0.2965261 x4 <--- x3
5 ev1.2
0.8315277 x1 <--> x1
6 ev4.2
0.6371700 x4 <--> x4
7 v2.21.0000000 x2 <--> x2
8 v3.21.0000000 x3 <--> x3
9 c23.2
0.1374377 x3 <--> x2>
9 c23.2-0.1686323 x3 <--> x2
正規雇用群

1.44 (1)
失敗恐怖

0.75 (.14)

1.59 (.38)

非正規雇用群e 1 21.43 (.83)

e 4 19.19 (.64)

R2=0.17R2=0.36ストレス.52 (.48)

1.28 (1)
失敗恐怖

うつ傾向

-1.02 (-.17)-.25 (-.22)

1.88 (.39)

e 1 18.55 (.63)

e 4 23.75 (.44)

R2=0.37

R2=0.56

ストレス.72 (.53)

うつ傾向-.41 (-.40)-.47 (-.34)-.36 (-.30)
20.80 (1)28.51 (1)

ソーシャル
サポート

ソーシャル
サポート

非標準化解 (標準化解)X2=6.04, df =2, p=0.049,
AGFI=0.90, RMSEA=0.13, CFI=0.98 , AIC=42.04

310

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多母集団のパス解析 ― specifyModel関数
library(sem)opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデル名1 <- specifyModel()構造方程式
モデル名2 <- specifyModel()
構造方程式…
群分け変数名 <- factor(群分け変数名)
mgオブジェクト名 <- multigroupModel(モデル名1, モデル名2, …, groups=levels(群分け変数名))
semオブジェクト名 <- sem(mgオブジェクト名, data=データ行列, group="群分け変数")
summary(semオブジェクト名)
stdCoef(semオブジェクト名)
群分け変数名に「group」を用いると不具合が生じることがあるので他の名前を使う
群分け変数のfactor化で，levels=c(水準1,水準2,…), labels=c(ラベル1,ラベル2,…) を設定してもよい
各群のモデルで，同じパラメタ名にすると等値制約になる
群分け変数名はfactor関数を使ってfactor化しておかなければならない
等値制約を加える場合は，例えば，b12.1 と b12.2 をともに b12というパラメタ名にすると，両群に共通な b12 というパラメタ値を推定する
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 群別データ> d11 <- d1[d1$work==1, colnames(d1) %in% c("work")==F]> d10 <- d1[d1$work==0, colnames(d1) %in% c("work")==F]>>> # 記述統計量> dtmp <- d11[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu result
stress 122 23.10 5.08
1.00
0.35
-0.17 0.53
0.33
kyoufu 122 4.17 1.20
0.35
1.00
0.14 0.27
0.17
support 122 18.25 4.56 -0.17
0.14
1.00 -0.38 -0.31
utsu
122 20.44 5.49
0.53
0.27
-0.38 1.00
0.75
result 122 0.22 0.42
0.33
0.17
-0.31 0.75
1.00
>
311

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> dtmp <- d10[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu result
stress 123 22.78 5.43
1.00
0.46
-0.47 0.69
0.54
kyoufu 123 3.93 1.13
0.46
1.00
-0.17 0.35
0.25
support 123 18.59 5.34 -0.47 -0.17
1.00 -0.59 -0.45
utsu
123 20.13 7.38
0.69
0.35
-0.59 1.00
0.79
result 123 0.29 0.46
0.54
0.25
-0.45 0.79
1.00>>
> #変数名の変更（式を書くのにはこのほうが簡単）> # x1:ストレス x2:失敗恐怖 x3:ソーシャルサポート x4:うつ傾向> colnames(d1) <- c("id", "x1", "x2", "x3", "x4","work","result")> head(d1)
id x1 x2 x3 x4 work result
1 1 20 2.2 17 18
00
2 2 23 4.8 18 21
10
3 3 30 5.8 12 29
11
4 4 25 5.2 18 29
01
5 5 26 2.0 8 2210
6 6 21 5.0 26 19
1
0>>> #sem パッケージの読み込み> library(sem)>> # 適合度指標出力の指定> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))>> # モデルの設定> # specifyModel を使う方法> smd.1 <- specifyModel()1: x1 <- x2, b12.1, NA
2: x1 <- x3, b13.1, NA
3: x4 <- x1, b41.1, NA
4: x4 <- x3, b43.1, NA
5: x1 <-> x1, ev1.1, NA
6: x4 <-> x4, ev4.1, NA
7: x2 <-> x2, v2.1, NA
8: x3 <-> x3, v3.1, NA
9: x2 <-> x3, c23.1, NA
10:Read 9 records
NOTE: it is generally simpler to use specifyEquations() or cfa()
see ?specifyEquations> smd.2 <- specifyModel()1: x1 <- x2, b12.2, NA
2: x1 <- x3, b13.2, NA
3: x4 <- x1, b41.2, NA
4: x4 <- x3, b43.2, NA
5: x1 <-> x1, ev1.2, NA
6: x4 <-> x4, ev4.2, NA
7: x2 <-> x2, v2.2, NA
8: x3 <-> x3, v3.2, NA
9: x2 <-> x3, c23.2, NA
10:
Read 9 records
NOTE: it is generally simpler to use specifyEquations() or cfa()
see ?specifyEquations312名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 多母集団分析> d1$work <- factor(d1$work)> mg.smd <- multigroupModel(smd.1, smd.2, groups=levels(d1$work))> sem.mg.smd <- sem(mg.smd, data=d1, group="work")> summary(sem.mg.smd)
Model Chisquare = 6.042957 Df = 2 Pr(>Chisq) = 0.04872913
Chisquare (null model) = 246.2831 Df = 12
Goodness-of-fit index = 0.9880118
Adjusted goodness-of-fit index = 0.9040942
RMSEA index = 0.1289871 90% CI: (0.008417286, 0.2528073)
Bentler-Bonett NFI = 0.9754634
Tucker-Lewis NNFI = 0.8964597
Bentler CFI = 0.9827433
Bentler RNI = 0.9827433
Bollen IFI = 0.9834497
SRMR = 0.0314776
AIC = 42.04296
AICc = 9.069505
BIC = -4.95956
Iterations: initial fits, 0 0

final fit, 0

work: 0Model Chisquare = 0.9026323
Df = 1 Pr(>Chisq) = 0.3420769
Goodness-of-fit index = 0.9963279
Adjusted goodness-of-fit index = 0.9632787
RMSEA index = 0
90% CI: (NA, 0.23476)
Bentler-Bonett NFI = 0.9944273
Tucker-Lewis NNFI = 1.003746
Bentler CFI = 1
Bentler RNI = 1.000624
Bollen IFI = 1.000605
SRMR = 0.01590207
AIC = 18.90263
AICc = 2.495553
BIC = -3.909552
CAIC = -4.909552
Normalized Residuals
Min. 1st Qu. Median
0.0000 0.0000 0.0000

Mean 3rd Qu.
0.0665 0.0000

Max.
0.5320R-square for Endogenous Variables
x1
x4
0.3704 0.5634
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12.1 1.8791914 0.34991236 5.370463 7.853478e-08 x1 <--- x2
b13.1 -0.4114030 0.07410181 -5.551862 2.826424e-08 x1 <--- x3
b41.1 0.7164477 0.09212589 7.776834 7.436204e-15 x4 <--- x1
b43.1 -0.4709965 0.09366555 -5.028493 4.943508e-07 x4 <--- x3
ev1.1 18.5541031 2.37560947 7.810250 5.707481e-15 x1 <--> x1
ev4.1 23.7533710 3.04130751 7.810250 5.707481e-15 x4 <--> x4
v2.1
1.2784699 0.16369130 7.810250 5.707481e-15 x2 <--> x2
v3.1 28.5069972 3.64994698 7.810250 5.707481e-15 x3 <--> x3
c23.1 -1.0180328 0.55428088 -1.836673 6.625817e-02 x3 <--> x2
work: 1Model Chisquare = 5.140324
Df = 1 Pr(>Chisq) = 0.02337628
Goodness-of-fit index = 0.9796275
Adjusted goodness-of-fit index = 0.7962752
RMSEA index = 0.1849799
90% CI: (0.05473528, 0.3556438)
Bentler-Bonett NFI = 0.9390293
Tucker-Lewis NNFI = 0.6827666
Bentler CFI = 0.9471278
313

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Bentler RNI = 0.9471278
Bollen IFI = 0.9503011
SRMR = 0.04718079
AIC = 23.14032
AICc = 6.747467
BIC = 0.3363034
CAIC = -0.6636966
Normalized Residuals
Min. 1st Qu. Median
0.0000 0.0000 0.0000

Mean 3rd Qu.
0.2036 0.0000

Max.
1.6286R-square for Endogenous Variablesx1
x4
0.1685 0.3628
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12.2 1.5940497 0.35351596 4.509131 6.509380e-06 x1 <--- x2
b13.2 -0.2464606 0.09316002 -2.645562 8.155534e-03 x1 <--- x3
b41.2 0.5150020 0.07959184 6.470538 9.765471e-11 x4 <--- x1
b43.2 -0.3567843 0.08859546 -4.027118 5.646481e-05 x4 <--- x3
ev1.2 21.4329344 2.75552240 7.778175 7.357848e-15 x1 <--> x1
ev4.2 19.1893399 2.46707498 7.778175 7.357848e-15 x4 <--> x4
v2.2
1.4446416 0.18573016 7.778175 7.357848e-15 x2 <--> x2
v3.2 20.8026690 2.67449242 7.778175 7.357848e-15 x3 <--> x3
c23.2 0.7534345 0.50304910 1.497736 1.342020e-01 x3 <--> x2> stdCoef(sem.mg.smd)
Group:

0
Std. Estimate
1 b12.1
0.3914194 x1 <--- x2
2 b13.1-0.4046404 x1 <--- x3
3 b41.1
0.5272571 x4 <--- x1
4 b43.1-0.3409239 x4 <--- x3
5 ev1.1
0.6296396 x1 <--> x1
6 ev4.1
0.4365693 x4 <--> x4
7 v2.11.0000000 x2 <--> x2
8 v3.11.0000000 x3 <--> x3
9 c23.1-0.1686323 x3 <--> x2
Group:

1
Std. Estimate
1 b12.2
0.3773805 x1 <--- x2
2 b13.2-0.2214137 x1 <--- x3
3 b41.2
0.4764409 x4 <--- x1
4 b43.2-0.2965261 x4 <--- x3
5 ev1.2
0.8315277 x1 <--> x1
6 ev4.2
0.6371700 x4 <--> x4
7 v2.21.0000000 x2 <--> x2
8 v3.21.0000000 x3 <--> x3
9 c23.2
0.1374377 x3 <--> x2
>
>

正規雇用群

1.44 (1)
失敗恐怖

0.75 (.14)

1.59 (.38)

非正規雇用群e 1 21.43 (.83)

e 4 19.19 (.64)

R2=0.17R2=0.36ストレス.52 (.48)

うつ傾向1.28 (1)失敗恐怖-1.02 (-.17)-.25 (-.22)

e 4 23.75 (.44)

R2=0.37

R2=0.56

ストレス.72 (.53)

うつ傾向-.41 (-.40)-.47 (-.34)-.36 (-.30)
20.80 (1)28.51 (1)

ソーシャル
サポート

ソーシャル
サポート

非標準化解 (標準化解)X2=6.04, df =2, p=0.049,
AGFI=0.90, RMSEA=0.13, CFI=0.98 , AIC=42.04

314

1.88 (.39)

e 1 18.55 (.63)

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多母集団パス解析におけるパス係数の検定
制約モデル
b12 と b43 をモデル間で共通にする
seq.1 <- specifyEquations()
x1 = b12*x2 + b13.1*x3x4 = b41.1*x1 + b43*x3
V(x1) = ev1.1
V(x4) = ev4.1
V(x2) = v2.1
V(x3) = v3.1
C(x2,x3) = c23.1
seq.2 <- specifyEquations()
x1 = b12*x2 + b13.2*x3x4 = b41.2*x1 + b43*x3
V(x1) = ev1.2
V(x4) = ev4.2
V(x2) = v2.2
V(x3) = v3.2
C(x2,x3) = c23.2
d1$work <- factor(d1$work)mg.seq <- multigroupModel(seq.1, seq.2, groups=levels(d1$work))
sem.mg.seq <- sem(mg.seq, data=d1, group="work")

パス係数の検定
H0： β13.1 ＝β13.2など# パス係数の差の値(vb <- sem.mg.seq$coeff)(vb1 <- vb[c("b12.1","b13.1","b41.1","b43.1")])(vb2 <- vb[c("b12.2","b13.2","b41.2","b43.2")])(vbd <- vb1-vb2)# パス係数の差の標準誤差の推定(vse <- sqrt(diag(sem.mg.seq$vcov)))(vve <- diag(sem.mg.seq$vcov))(vve1 <- vve[c("b12.1","b13.1","b41.1","b43.1")])(vve2 <- vve[c("b12.2","b13.2","b41.2","b43.2")])(vse12 <- sqrt(vve1 + vve2))# 検定(vz <- (vb1 - vb2)/ vse12)
2*(1-pnorm(abs(vz)))# 信頼区間の推定(z0 <- qnorm(.975))(vL <- (vb1 - vb2) - z0*vse12)(vU <- (vb1 - vb2) + z0*vse12)> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
315

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 群別データ> d11 <- d1[d1$work==1, colnames(d1) %in% c("work")==F]> d10 <- d1[d1$work==0, colnames(d1) %in% c("work")==F]>> # 記述統計量> dtmp <- d11[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu result
stress 122 23.10 5.08
1.00
0.35
-0.17 0.53
0.33
kyoufu 122 4.17 1.20
0.35
1.00
0.14 0.27
0.17
support 122 18.25 4.56 -0.17
0.14
1.00 -0.38 -0.31
utsu
122 20.44 5.49
0.53
0.27
-0.38 1.00
0.75
result 122 0.22 0.42
0.33
0.17
-0.31 0.75
1.00>
> dtmp <- d10[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu result
stress 123 22.78 5.43
1.00
0.46
-0.47 0.69
0.54
kyoufu 123 3.93 1.13
0.46
1.00
-0.17 0.35
0.25
support 123 18.59 5.34 -0.47 -0.17
1.00 -0.59 -0.45
utsu
123 20.13 7.38
0.69
0.35
-0.59 1.00
0.79
result 123 0.29 0.46
0.54
0.25
-0.45 0.79
1.00>
> #変数名の変更（式を書くのにはこのほうが簡単）> # x1:ストレス x2:失敗恐怖 x3:ソーシャルサポート x4:うつ傾向> colnames(d1) <- c("id", "x1", "x2", "x3", "x4","work","result")> head(d1)
id x1 x2 x3 x4 work result
1 1 20 2.2 17 18
00
2 2 23 4.8 18 21
10
3 3 30 5.8 12 29
11
4 4 25 5.2 18 29
01
5 5 26 2.0 8 2210
6 6 21 5.0 26 19
10>>> # 多母集団分析> library(sem)> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))>>> # 制約モデル> # b12 と b43 をモデル間で共通にする> seq.1 <- specifyEquations()
1: x1 = b12*x2 + b13.1*x3
2: x4 = b41.1*x1 + b43*x3
3: V(x1) = ev1.1
4: V(x4) = ev4.1
5: V(x2) = v2.1
6: V(x3) = v3.1
7: C(x2,x3) = c23.1
8:
Read 7 items
316

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> seq.2 <- specifyEquations()
1: x1 = b12*x2 + b13.2*x3
2: x4 = b41.2*x1 + b43*x3
3: V(x1) = ev1.2
4: V(x4) = ev4.2
5: V(x2) = v2.2
6: V(x3) = v3.2
7: C(x2,x3) = c23.2
8:
Read 7 items> d1$work <- factor(d1$work)> mg.seq <- multigroupModel(seq.1, seq.2, groups=levels(d1$work))> sem.mg.seq <- sem(mg.seq, data=d1, group="work")> summary(sem.mg.seq)
Model Chisquare = 7.154842 Df = 4 Pr(>Chisq) = 0.1279283
Chisquare (null model) = 246.2831 Df = 12
Goodness-of-fit index = 0.9856524
Adjusted goodness-of-fit index = 0.9426097
RMSEA index = 0.0805695 90% CI: (NA, 0.1744588)
Bentler-Bonett NFI = 0.9709487
Tucker-Lewis NNFI = 0.9596022
Bentler CFI = 0.9865341
Bentler RNI = 0.9865341
Bollen IFI = 0.9869787
SRMR = 0.03869427
AIC = 39.15484
AICc = 9.540807
BIC = -14.85019
Iterations: initial fits, 0 0

final fit, 41

work: 0Model Chisquare = 1.478764
Df = 1 Pr(>Chisq) = 0.223968
Goodness-of-fit index = 0.9941505
Adjusted goodness-of-fit index = 0.9415052
RMSEA index = 0.06264419
90% CI: (NA, 0.2589937)
Bentler-Bonett NFI = 0.9908704
Tucker-Lewis NNFI = 0.981583
Bentler CFI = 0.9969305
Bentler RNI = 0.9969305
Bollen IFI = 0.9970258
SRMR = 0.02701648
AIC = 19.47876
AICc = 3.071684
BIC = -3.33342
CAIC = -4.33342
Normalized Residuals
Min. 1st Qu.
Median-0.33145 0.00000 0.05265

Mean
0.11760

3rd Qu.
0.23191Max.
0.68641

R-square for Endogenous Variables
x1
x4
0.3562 0.5501
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12
1.7380842 0.24885864 6.984223 2.864368e-12 x1 <--- x2
b13.1 -0.4164422 0.07362779 -5.656047 1.548991e-08 x1 <--- x3
b41.1 0.7443567 0.08707909 8.548054 1.251811e-17 x4 <--- x1
b43-0.4107062 0.06032937 -6.807732 9.914902e-12 x4 <--- x3
ev1.1 18.5789349 2.37878885 7.810250 5.707481e-15 x1 <--> x1
ev4.1 23.8340009 3.05163111 7.810250 5.707481e-15 x4 <--> x4
v2.1
1.2784699 0.16369130 7.810250 5.707481e-15 x2 <--> x2
v3.1 28.5069972 3.64994698 7.810250 5.707481e-15 x3 <--> x3
c23.1 -1.0180328 0.55428088 -1.836673 6.625817e-02 x3 <--> x2
work: 1317

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Model Chisquare = 5.676078
Df = 1 Pr(>Chisq) = 0.01719777
Goodness-of-fit index = 0.9770847
Adjusted goodness-of-fit index = 0.7708467
RMSEA index = 0.196584
90% CI: (0.06622647, 0.3661187)
Bentler-Bonett NFI = 0.9326746
Tucker-Lewis NNFI = 0.6417169
Bentler CFI = 0.9402862
Bentler RNI = 0.9402862
Bollen IFI = 0.9438701
SRMR = 0.05046779
AIC = 23.67608
AICc = 7.283221
BIC = 0.8720571
CAIC = -0.1279429
Normalized Residuals
Min. 1st Qu. Median-0.3399 -0.1436 0.0000

Mean 3rd Qu.
0.1575 0.1087

Max.
1.5255R-square for Endogenous Variables
x1
x4
0.1896 0.3830
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b12
1.7380842 0.24885864 6.984223 2.864368e-12 x1 <--- x2
b13.2 -0.2516773 0.08818425 -2.853993 4.317342e-03 x1 <--- x3
b41.2 0.5067888 0.09277849 5.462352 4.698659e-08 x4 <--- x1
b43-0.4107062 0.06032937 -6.807732 9.914902e-12 x4 <--- x3
ev1.2 21.4625255 2.75932679 7.778175 7.357848e-15 x1 <--> x1
ev4.2 19.2480001 2.47461661 7.778175 7.357848e-15 x4 <--> x4
v2.2
1.4446416 0.18573016 7.778175 7.357848e-15 x2 <--> x2
v3.2 20.8026690 2.67449242 7.778175 7.357848e-15 x3 <--> x3
c23.2 0.7534345 0.50304910 1.497736 1.342020e-01 x3 <--> x2> stdCoef(sem.mg.seq)
Group:

0
Std. Estimate
1b12
0.3658290 x1 <--- x2
2 b13.1-0.4138973 x1 <--- x3
3 b41.1
0.5494062 x4 <--- x14
b43-0.3012877 x4 <--- x3
5 ev1.1
0.6437911 x1 <--> x1
6 ev4.1
0.4499310 x4 <--> x4
7 v2.11.0000000 x2 <--> x2
8 v3.11.0000000 x3 <--> x3
9 c23.1-0.1686323 x3 <--> x2

正規雇用群

非正規雇用群e 1 21.46 (.81)

e 4 19.25 (.62)

R2=0.19R2=0.37

1.44 (1)
失敗恐怖

0.75 (.14)

1.74 (.41)

ストレス.51 (.47)

うつ傾向1.28 (1)失敗恐怖-1.02 (-.17)-.25 (-.22)

28.51 (1)

ソーシャル
サポート

ソーシャル
サポート

非標準化解 (標準化解)X2=7.15, df =4, p=0.128,
AGFI=0.94, RMSEA=0.08, CFI=0.99, AIC=39.15

1
Std. Estimate
1b12
0.4059282 x1 <--- x2
2 b13.2-0.2230498 x1 <--- x3
3 b41.2
0.4669772 x4 <--- x14
b43-0.3353959 x4 <--- x3
5 ev1.2
0.8103589 x1 <--> x1
6 ev4.2
0.6170487 x4 <--> x4
7 v2.21.0000000 x2 <--> x2
8 v3.21.0000000 x3 <--> x3
9 c23.2
0.1374377 x3 <--> x2>

318

e 4 23.83 (.45)

R2=0.37

R2=0.56

ストレス.74 (.55)

うつ傾向-.42 (-.41)-.41 (-.30)-.41 (-.34)
20.80 (1)Group:

1.74 (.37)

e 1 18.58 (.64)

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # パス係数の検定> (vb <- sem.mg.seq$coeff)
b12
b13.1
b41.1
b43
ev1.1
ev4.1
1.7380842 -0.4164422 0.7443567 -0.4107062 18.5789349 23.8340009
v3.1
c23.1
b13.2
b41.2
ev1.2
ev4.2
28.5069972 -1.0180328 -0.2516773 0.5067888 21.4625255 19.2480001
v3.2
c23.2
20.8026690 0.7534345>

v2.1
1.2784699
v2.2
1.4446416> # 関心のあるパス係数の取り出し> (vb1 <- vb[c("b13.1","b41.1")])
b13.1
b41.1
-0.4164422 0.7443567> (vb2 <- vb[c("b13.2","b41.2")])
b13.2
b41.2
-0.2516773 0.5067888>> # パス係数の差> (vbd <- vb1-vb2)
b13.1
b41.1
-0.1647649 0.2375679>>> # パス係数の標準誤差> (vse <- sqrt(diag(sem.mg.seq$vcov)))
b12
b13.1
b41.1
b43
ev1.1
ev4.1
v2.1
0.24919533 0.07362920 0.08675249 0.06467567 2.38087824 3.05715764 0.16372405
v3.1
c23.1
b13.2
b41.2
ev1.2
ev4.2
v2.2
3.65067675 0.55428201 0.09277965 0.07917452 2.76178042 2.47910233 0.18576895
v3.2
c23.2
2.67505003 0.50304583>>> # パス係数の標準誤差の2乗> (vve <- diag(sem.mg.seq$vcov))
b12
b13.1
b41.1
b43
ev1.1
ev4.1
0.062098310 0.005421260 0.007525994 0.004182942 5.668581192 9.346212836
v2.1
v3.1
c23.1
b13.2
b41.2
ev1.2
0.026805563 13.327440737 0.307228541 0.008608063 0.006268604 7.627431081
ev4.2
v2.2
v3.2
c23.2
6.145948342 0.034510101 7.155892678 0.253055110>>> # 関心のあるパス係数の標準誤差の2乗の取り出し> (vve1 <- vve[c("b13.1","b41.1")])
b13.1
b41.1
0.005421260 0.007525994> (vve2 <- vve[c("b13.2","b41.2")])
b13.2
b41.2
0.008608063 0.006268604>>> #パス係数の差の標準誤差> vse12 <- sqrt(vve1 + vve2)> names(vse12) <- c("b13","b41")> vse12b13
b41
0.1184454 0.1174504>> # 検定統計量> vz <- (vb1 - vb2)/ vse12> names(vz) <- c("b13","b41")
> vz
b13
b41
-1.391062 2.022709>

319

名古屋 大学> # p値> vp <- 2*(1-pnorm(abs(vz)))> names(vp) <- c("b13","b41")
> vp
b13
b41
0.1642067 0.0431032>>> # 信頼区間の推定> (z0 <- qnorm(.975))[1] 1.959964> vL <- (vb1 - vb2) - z0*vse12> vU <- (vb1 - vb2) + z0*vse12> names(vL) <- c("b13L","b41L")> names(vU) <- c("b13U","b41U")
> vL
b13L
b41L
-0.396913743 0.007369375
> vU
b13U
b41U
0.06738386 0.46776651
>
>
>

320

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

確認的因子分析パッケージの読み込み
library(sem)opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデルの設定specifyEquations を使う方法
モデル名 <- specifyEquations()
予測式
V(変数名.)= 分散，誤差分散を表すパラメタ（または設定値）
C(変数名1, 変数名2)= 共分散表すパラメタ（または設定値）
specifyModel を使う方法
モデル名 <- specifyModel()各パラメタ（または設定値）を設定する式
パラメタ値の推定
semオブジェクト名 <- sem(モデル名, 共分散行列（またはデータ行列）, N=標本サイズ)
summary(semオブジェクト名)
標準化解の推定
stdCoef(semオブジェクト名)
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）

モデル部分のスクリプトの例
確認的因子分析モデル x1, x2, x3, x4, x5 の背後にf1を仮定
x5, x6, x7, x8, x10 の背後にf2を仮定
f1 と f2 の間に相関を仮定
seq.1 <- specifyEquations()
x1 = b1*f1# 測定方程式
x2 = b2*f1
x3 = b3*f1
x4 = b4*f1
x5 = b5*f1
x6 = b6*f2
x7 = b7*f2
x8 = b8*f2
x9 = b9*f2
x10 = b10*f2
V(x1)= ev1# 内生変数の誤差分散
V(x2)= ev2
V(x3)= ev3
V(x4)= ev4
V(x5)= ev5
V(x6)= ev6
V(x7)= ev7
V(x8)= ev8
V(x9)= ev9
V(x10)= ev10
V(f1) = 1
# 外生変数の分散
V(f2) = 1
C(f1,f2) =cf12# 外生変数の共分散

321

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("i:\\Rdocuments\\scripts\\")> d1 <- read.table("統計分析力尺度データ.csv",header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 xt yt
1
1 3 2 1 2 2 4 4 3 4
4 3 2 1 2 1 4 3 3 3
4 29 262
2 3 3 4 3 2 2 2 2 4
1 2 2 4 2 2 1 1 1 3
1 26 193
3 4 3 3 4 1 3 4 2 5
1 4 3 4 4 1 3 4 2 5
1 30 314
4 5 5 5 3 3 4 4 2 4
4 5 4 5 2 2 3 4 2 3
3 39 335
5 3 3 4 2 2 3 3 3 4
1 3 4 4 3 2 4 3 4 5
1 28 33
6
6 2 1 4 1 1 3 3 2 5
1 3 2 4 2 2 5 4 3 5
2 23 32
統計 数学 批判的思考力 国語 自己効力感
1
51
48
28
72
61
2
74
53
26
66
53
3
48
60
35
71
48
4
67
68
27
67
48
5
55
49
30
66
49
6
74
63
36
83
37
>
> vn.itemx <- c("x1","x2","x3","x4","x5","x6","x7","x8","x9","x10")>>> # 記述統計量> dtmp <- d1[,vn.itemx]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean
SD
x1
x2
x3
x4
x5
x6
x7
x8
x9 x10x1 365 3.99 0.92 1.00 0.47 0.46 0.49 0.49 0.29 0.32 0.25 0.25 0.27
x2 365 3.09 0.96 0.47 1.00 0.48 0.49 0.52 0.28 0.27 0.33 0.27 0.20
x3 365 4.06 0.85 0.46 0.48 1.00 0.45 0.47 0.31 0.25 0.26 0.27 0.20
x4 365 3.00 1.07 0.49 0.49 0.45 1.00 0.50 0.24 0.29 0.31 0.32 0.25
x5 365 2.19 0.93 0.49 0.52 0.47 0.50 1.00 0.30 0.26 0.29 0.23 0.24
x6 365 3.04 1.01 0.29 0.28 0.31 0.24 0.30 1.00 0.44 0.43 0.43 0.46
x7 365 3.12 0.99 0.32 0.27 0.25 0.29 0.26 0.44 1.00 0.44 0.37 0.35
x8 365 2.15 0.89 0.25 0.33 0.26 0.31 0.29 0.43 0.44 1.00 0.34 0.41
x9 365 3.91 0.90 0.25 0.27 0.27 0.32 0.23 0.43 0.37 0.34 1.00 0.30
x10 365 2.13 0.95 0.27 0.20 0.20 0.25 0.24 0.46 0.35 0.41 0.30 1.00>>
> # 共分散行列・相関係数行列> cov.d1 <- cov(d1[,vn.itemx])> cor.d1 <- cor(d1[,vn.itemx])>>> # 確認的因子分析> library(sem)> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))>> seq.1 <- specifyEquations()
1: x1 = b1*f1
2: x2 = b2*f1
3: x3 = b3*f1
4: x4 = b4*f1
5: x5 = b5*f1
6: x6 = b6*f2
7: x7 = b7*f2
8: x8 = b8*f2
9: x9 = b9*f2
10: x10 = b10*f2
11: V(x1)= ev1
12: V(x2)= ev2
13: V(x3)= ev3
14: V(x4)= ev4
15: V(x5)= ev5
16: V(x6)= ev6
17: V(x7)= ev7
18: V(x8)= ev8322

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

19: V(x9)= ev9
20: V(x10)= ev10
21: V(f1) = 1
22: V(f2) = 1
23: C(f1,f2) =cf12
24:
Read 23 items> sem.seq.1 <- sem(seq.1, cor.d1, N=nrow(d1))> summary(sem.seq.1)
Model Chisquare = 33.88776
Df = 34 Pr(>Chisq) = 0.4731506
Goodness-of-fit index = 0.982311
Adjusted goodness-of-fit index = 0.9713855
RMSEA index = 0
90% CI: (NA, 0.03787012)
Bentler-Bonett NFI = 0.9692328
Tucker-Lewis NNFI = 1.000141
Bentler CFI = 1
Bentler RNI = 1.000106
Bollen IFI = 1.000105
SRMR = 0.02521577
AIC = 75.88776
AICc = 36.58164
BIC = -166.7088
CAIC = -200.7088
Normalized Residuals
Min.
1st Qu.
Median-1.126000 -0.301100 -0.000002

Mean
0.012060

3rd Qu.
0.269200Max.
1.400000

R-square for Endogenous Variables
x1
x2
x3
x4
x5
x6
x7
x8
x9
x10
0.4690 0.5038 0.4368 0.4860 0.5123 0.4989 0.4060 0.4250 0.3283 0.3516
Parameter Estimates
Estimate Std Error z value
Pr(>|z|)b1
0.6848289 0.04997713 13.702846 9.762113e-43 x1 <--- f1
b2
0.7098060 0.04944059 14.356748 9.665789e-47 x2 <--- f1
b3
0.6609198 0.05048056 13.092560 3.631562e-39 x3 <--- f1
b4
0.6971099 0.04971444 14.022283 1.138914e-44 x4 <--- f1
b5
0.7157307 0.04931213 14.514292 9.836799e-48 x5 <--- f1
b6
0.7063319 0.05138262 13.746513 5.344417e-43 x6 <--- f2
b7
0.6371831 0.05261420 12.110479 9.294967e-34 x7 <--- f2
b8
0.6519190 0.05235028 12.453017 1.346562e-35 x8 <--- f2
b9
0.5729784 0.05374247 10.661557 1.539969e-26 x9 <--- f2
b10 0.5929581 0.05339759 11.104585 1.191696e-28 x10 <--- f2
ev1 0.5310095 0.04785074 11.097207 1.294250e-28 x1 <--> x1
ev2 0.4961756 0.04622789 10.733253 7.105019e-27 x2 <--> x2
ev3 0.5631851 0.04943157 11.393227 4.519360e-30 x3 <--> x3
ev4 0.5140380 0.04704727 10.925989 8.659161e-28 x4 <--> x4
ev5 0.4877297 0.04585069 10.637346 1.997373e-26 x5 <--> x5
ev6 0.5010953 0.05033465 9.955276 2.391579e-23 x6 <--> x6
ev7 0.5939976 0.05365121 11.071467 1.725533e-28 x7 <--> x7
ev8 0.5750016 0.05289307 10.871018 1.584232e-27 x8 <--> x8
ev9 0.6716955 0.05706458 11.770796 5.520148e-32 x9 <--> x9
ev10 0.6484007 0.05599640 11.579328 5.245554e-31 x10 <--> x10
cf12 0.6115912 0.04689208 13.042526 7.009518e-39 f2 <--> f1
Iterations =13> stdCoef(sem.seq.1)
Std. Estimate1b1
0.6848288
2b2
0.7098060
3b30.6609198
4
b4
0.6971098
5
b5
0.7157307
6
b6
0.7063318
7b70.63718328b8
0.6519190
9b90.5729785
10 b100.5929581

x1 <--- f1
x2 <--- f1
x3 <--- f1
x4 <--- f1
x5 <--- f1
x6 <--- f2
x7 <--- f2
x8 <--- f2
x9 <--- f2
x10 <--- f2
323

名古屋 大学
11 ev1
12 ev213 ev314 ev415 ev516 ev617 ev718 ev819 ev920 ev1021
22
23 cf12>>>

大 学院 教育発 達科 学研 究科・ 教育 学部

0.5310095
x1 <--> x1
0.4961755
x2 <--> x2
0.5631851x3 <--> x3
0.5140379
x4 <--> x4
0.4877296
x5 <--> x5
0.5010953
x6 <--> x6
0.5939976
x7 <--> x7
0.5750016
x8 <--> x8
0.6716956
x9 <--> x9
0.6484007 x10 <--> x10
1.0000000
f1 <--> f1
1.0000000
f2 <--> f2
0.6115912
f2 <--> f1>> # 測定モデルの１つのパス係数を1にするモデル> seq.2 <- specifyEquations()
1: x1 = 1*f1
2: x2 = b21*f1
3: x3 = b31*f1
4: x4 = b41*f1
5: x5 = b51*f1
6: x6 = 1*f2
7: x7 = b72*f2
8: x8 = b82*f2
9: x9 = b92*f2
10: x10 = b102*f2
11: V(x1)= ev1
12: V(x2)= ev2
13: V(x3)= ev3
14: V(x4)= ev4
15: V(x5)= ev5
16: V(x6)= ev6
17: V(x7)= ev7
18: V(x8)= ev8
19: V(x9)= ev9
20: V(x10)= ev10
21: V(f1) = vf1
22: V(f2) = vf2
23: C(f1,f2) =cf12
24:
Read 23 items> sem.seq.2 <- sem(seq.2, cor.d1, N=nrow(d1))> summary(sem.seq.2)
Model Chisquare = 33.88776
Df = 34 Pr(>Chisq) = 0.4731506
Goodness-of-fit index = 0.982311
Adjusted goodness-of-fit index = 0.9713855
RMSEA index = 0
90% CI: (NA, 0.03787012)
Bentler-Bonett NFI = 0.9692328
Tucker-Lewis NNFI = 1.000141
Bentler CFI = 1
Bentler RNI = 1.000106
Bollen IFI = 1.000105
SRMR = 0.02521578
AIC = 75.88776
AICc = 36.58164
BIC = -166.7088
CAIC = -200.7088
Normalized Residuals
Min.
1st Qu.
Median-1.1260000 -0.3011000 -0.0000011

Mean
0.0120600

3rd Qu.
0.2692000

Max.
1.4000000

R-square for Endogenous Variables
x1
x2
x3
x4
x5
x6
x7
x8
x9
x10
0.4690 0.5038 0.4368 0.4860 0.5123 0.4989 0.4060 0.4250 0.3283 0.3516
324

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Parameter Estimates
Estimate Std Error z value
Pr(>|z|)b21 1.0364720 0.09060888 11.438968 2.670440e-30 x2 <--- f1
b31 0.9650876 0.08947584 10.786013 4.008021e-27 x3 <--- f1
b41 1.0179327 0.09028794 11.274293 1.757850e-29 x4 <--- f1
b51 1.0451237 0.09076681 11.514381 1.116579e-30 x5 <--- f1
b72 0.9021016 0.08930775 10.101045 5.465677e-24 x7 <--- f2
b82 0.9229635 0.08972783 10.286257 8.127490e-25 x8 <--- f2
b92 0.8112034 0.08782609 9.236473 2.547551e-20 x9 <--- f2
b102 0.8394897 0.08823871 9.513848 1.837376e-21 x10 <--- f2
ev1 0.5310093 0.04785071 11.097207 1.294251e-28 x1 <--> x1
ev2 0.4961754 0.04622787 10.733253 7.104984e-27 x2 <--> x2
ev3 0.5631850 0.04943156 11.393227 4.519349e-30 x3 <--> x3
ev4 0.5140379 0.04704726 10.925991 8.658991e-28 x4 <--> x4
ev5 0.4877294 0.04585067 10.637344 1.997424e-26 x5 <--> x5
ev6 0.5010953 0.05033465 9.955275 2.391597e-23 x6 <--> x6
ev7 0.5939979 0.05365123 11.071468 1.725514e-28 x7 <--> x7
ev8 0.5750022 0.05289310 10.871024 1.584124e-27 x8 <--> x8
ev9 0.6716954 0.05706459 11.770793 5.520301e-32 x9 <--> x9
ev10 0.6484003 0.05599638 11.579325 5.245723e-31 x10 <--> x10
vf1 0.4689906 0.06845154 6.851424 7.311836e-12 f1 <--> f1
vf2 0.4989046 0.07258636 6.873256 6.275275e-12 f2 <--> f2
cf12 0.2958367 0.04229842 6.994038 2.670857e-12 f2 <--> f1
Iterations =26> stdCoef(sem.seq.2)
Std. Estimate
1
0.6848289
x1 <--- f12
b21
0.7098060
x2 <--- f1
3
b31
0.6609198
x3 <--- f1
4
b41
0.6971098
x4 <--- f1
5
b51
0.7157308
x5 <--- f1
6
0.7063318
x6 <--- f2
7b72
0.6371830x7 <--- f2
8b82
0.6519185
x8 <--- f2
9b92
0.5729787
x9 <--- f2
10 b1020.5929583 x10 <--- f2
11 ev1
0.5310094
x1 <--> x1
12 ev20.4961755
x2 <--> x2
13 ev30.5631850x3 <--> x3
14 ev40.5140380
x4 <--> x4
15 ev50.4877294
x5 <--> x5
16 ev60.5010953
x6 <--> x6
17 ev70.5939978
x7 <--> x7
18 ev80.5750022
x8 <--> x8
19 ev90.6716954
x9 <--> x9
20 ev100.6484004 x10 <--> x10
21 vf11.0000000
f1 <--> f1
22 vf21.0000000
f2 <--> f2
23 cf120.6115913
f2 <--> f1
>
>
>

325

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

探索的因子分析
スクリープロット
library(psych)
VSS.scree(データフレーム名，または，相関係数行列名)
あらかじめpsychパッケージをインストールしておく必要がある．
探索的因子分析
library(psych)
library(GPArotation)
オブジェクト名 <- fa(データフレーム名, nfactors=因子数, rotate="回転法", fm="推定法")
または
オブジェクト名 <- fa(相関係数行列名, n.obs=データ数, nfactors=因子数, rotate="回転法", fm="推定法")
print(オブジェクト名, sort=TRUE)
あらかじめpsychパッケージをインストールしておく必要がある．
GPArotationパッケージもインストールしておくとよい．
共通性初期推定値はSMCになる．
回転方法（rotate）
直交回転："none", "varimax", "quartimax", "bentlerT", "geominT"
斜交回転："promax", "oblimin", "simplimax", "bentlerQ, "geominQ" , "cluster"
推定法（fm）
重み無し最小２乗法："minres" ， 重み付き最小２乗法："wls"， 一般化重み付き最小２乗法："gls"，
主軸法（反復主因子法）："pa"， 最尤法："ml"【重要!!】
sort=TRUE により，各項目は因子負荷が一番大きい因子にセットされ，各因子においては，因子負荷の大きい順に，セットされた項目が並べ替えられる．
独自性（u2）＝１－ 共通性（h2）である．

> setwd("d:\\")> d1 <- read.table("統計分析力尺度データ.csv",header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 xt yt
1
1 3 2 1 2 2 4 4 3 4
4 3 2 1 2 1 4 3 3 3
4 29 262
2 3 3 4 3 2 2 2 2 4
1 2 2 4 2 2 1 1 1 3
1 26 193
3 4 3 3 4 1 3 4 2 5
1 4 3 4 4 1 3 4 2 5
1 30 314
4 5 5 5 3 3 4 4 2 4
4 5 4 5 2 2 3 4 2 3
3 39 335
5 3 3 4 2 2 3 3 3 4
1 3 4 4 3 2 4 3 4 5
1 28 33
6
6 2 1 4 1 1 3 3 2 5
1 3 2 4 2 2 5 4 3 5
2 23 32
統計 数学 批判的思考力 国語 自己効力感
1
51
48
28
72
61
2
74
53
26
66
53
3
48
60
35
71
48
4
67
68
27
67
48
5
55
49
30
66
49
6
74
63
36
83
37
>
> vn.itemx <- c("x1","x2","x3","x4","x5","x6","x7","x8","x9","x10")>> d2 <- d1[,vn.itemx]>>> # 記述統計量> dtmp <- d2> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmp326

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

N Mean
SD
x1
x2
x3
x4
x5
x6
x7
x8
x9 x10x1 365 3.99 0.92 1.00 0.47 0.46 0.49 0.49 0.29 0.32 0.25 0.25 0.27
x2 365 3.09 0.96 0.47 1.00 0.48 0.49 0.52 0.28 0.27 0.33 0.27 0.20
x3 365 4.06 0.85 0.46 0.48 1.00 0.45 0.47 0.31 0.25 0.26 0.27 0.20
x4 365 3.00 1.07 0.49 0.49 0.45 1.00 0.50 0.24 0.29 0.31 0.32 0.25
x5 365 2.19 0.93 0.49 0.52 0.47 0.50 1.00 0.30 0.26 0.29 0.23 0.24
x6 365 3.04 1.01 0.29 0.28 0.31 0.24 0.30 1.00 0.44 0.43 0.43 0.46
x7 365 3.12 0.99 0.32 0.27 0.25 0.29 0.26 0.44 1.00 0.44 0.37 0.35
x8 365 2.15 0.89 0.25 0.33 0.26 0.31 0.29 0.43 0.44 1.00 0.34 0.41
x9 365 3.91 0.90 0.25 0.27 0.27 0.32 0.23 0.43 0.37 0.34 1.00 0.30
x10 365 2.13 0.95 0.27 0.20 0.20 0.25 0.24 0.46 0.35 0.41 0.30 1.00>>
> # 共分散行列・相関係数行列> cov.d2 <- cov(d2)> cor.d2 <- cor(d2)>> #スクリープロット> library(psych)> VSS.scree(cor.d2) # VSS.scree(d2) でも同じ>>>
> #因子分析の実行> library(psych)>> # データ行列から分析> fac.1 <- fa(d2, nfactors=2, rotate="promax", fm="wls")> print(fac.1, sort=TRUE)
Factor Analysis using method = wls
Call: fa(r = d2, nfactors = 2, rotate = "promax", fm = "wls")
Standardized loadings (pattern matrix) based upon correlation matrix
item WLS1 WLS2h2
u2 comx5
5 0.73 -0.02 0.51 0.49
1x2
2 0.72 -0.01 0.51 0.49
1x4
4 0.68 0.02 0.49 0.51
1x1
1 0.66 0.04 0.46 0.54
1x3
3 0.65 0.02 0.43 0.57
1x6
6 -0.05 0.75 0.52 0.48
1x10
10 -0.05 0.63 0.36 0.64
1x8
8 0.04 0.62 0.42 0.58
1x7
7 0.03 0.61 0.40 0.60
1x9
9 0.07 0.52 0.32 0.68
1
WLS1 WLS2
SS loadings
2.41 2.02
Proportion Var
0.24 0.20
Cumulative Var
0.24 0.44
Proportion Explained 0.54 0.46
Cumulative Proportion 0.54 1.00
With factor correlations of
WLS1 WLS2
WLS1 1.0 0.6
WLS2 0.6 1.0
Mean item complexity = 1
Test of the hypothesis that 2 factors are sufficient.
The degrees of freedom for the null model are 45 and the objective function was
Square of 1088.82
The degrees of freedom for the model are 26 and the objective function was 0.08
The root mean square of the residuals (RMSR) is 0.02
The df corrected root mean square of the residuals is

3.03 with Chi

0.03

The harmonic number of observations is 365 with the empirical chi square 18.62 with prob < 0.
85
The total number of observations was 365 with Likelihood Chi Square = 30.21 with prob < 0.26

327

名古屋 大学
Tucker Lewis Index of factoring reliability = 0.993
RMSEA index = 0.021 and the 90 % confidence intervals are
BIC = -123.18
Fit based upon off diagonal values = 1
Measures of factor score adequacy
WLS1 WLS2
Correlation of (regression) scores with factors
0.91 0.89
Multiple R square of scores with factors
0.83 0.80
Minimum correlation of possible factor scores
0.67 0.59

大 学院 教育発 達科 学研 究科・ 教育 学部
0 0.048> # 相関行列から分析> fac.2 <- fa(r=cor.d2, n.obs=nrow(d2), nfactors=2, rotate="promax", fm="wls")> print(fac.2, sort=TRUE)
Factor Analysis using method = wls
Call: fa(r = cor.d2, nfactors = 2, n.obs = nrow(d2), rotate = "promax",
fm = "wls")
Standardized loadings (pattern matrix) based upon correlation matrix
item WLS1 WLS2h2
u2 comx5
5 0.73 -0.02 0.51 0.49
1x2
2 0.72 -0.01 0.51 0.49
1x4
4 0.68 0.02 0.49 0.51
1x1
1 0.66 0.04 0.46 0.54
1x3
3 0.65 0.02 0.43 0.57
1x6
6 -0.05 0.75 0.52 0.48
1x10
10 -0.05 0.63 0.36 0.64
1x8
8 0.04 0.62 0.42 0.58
1x7
7 0.03 0.61 0.40 0.60
1x9
9 0.07 0.52 0.32 0.68
1
WLS1 WLS2
SS loadings
2.41 2.02
Proportion Var
0.24 0.20
Cumulative Var
0.24 0.44
Proportion Explained 0.54 0.46
Cumulative Proportion 0.54 1.00
With factor correlations of
WLS1 WLS2
WLS1 1.0 0.6
WLS2 0.6 1.0
Mean item complexity = 1
Test of the hypothesis that 2 factors are sufficient.
The degrees of freedom for the null model are 45 and the objective function was
Square of 1088.82
The degrees of freedom for the model are 26 and the objective function was 0.08
The root mean square of the residuals (RMSR) is 0.02
The df corrected root mean square of the residuals is

3.03 with Chi

0.03

The harmonic number of observations is 365 with the empirical chi square 18.62 with prob < 0.
85
The total number of observations was 365 with Likelihood Chi Square = 30.21 with prob < 0.26
Tucker Lewis Index of factoring reliability = 0.993
RMSEA index = 0.021 and the 90 % confidence intervals are
BIC = -123.18
Fit based upon off diagonal values = 1
Measures of factor score adequacy
WLS1 WLS2
Correlation of (regression) scores with factors
0.91 0.89
Multiple R square of scores with factors
0.83 0.80
Minimum correlation of possible factor scores
0.67 0.59

328

0 0.048

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２次因子分析
library(sem)opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデル名 <- specifyEquations()
構造方程式
sem(モデル名, 共分散行列（またはデータ行列名）, N=標本サイズ)
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）
モデル部分のスクリプトの例
seq.1 <- specifyEquations()
x1 = 1*f1# 測定方程式
x2 = b2*f1# f1の分散を1としても，f1の1つの測定方程式のパス係数を1としても同等の制約
x3 = b3*f1
x4 = 1*f2
x5 = b5*f2
x6 = b6*f2
x7 = 1*f3
x8 = b8*f3
x9 = b9*f3
x10 = 1*f4
x11 = b11*f4
x12 = b12*f4
f1 = a1*f0# 潜在変数間の構造方程式
f2 = a2*f0
f3 = a3*f0
f4 = a4*f0
V(x1) = ev1# 内生変数の誤差分散
V(x2) = ev2
V(x3) = ev3
V(x4) = ev4
V(x5) = ev5
V(x6) = ev6
V(x7) = ev7
V(x8) = ev8
V(x9) = ev9
V(x10) = ev10
V(x11) = ev11
V(x12) = ev12
V(f1) = evf1
V(f2) = evf2
V(f3) = evf3
V(f4) = evf4
V(f0) = 1
# 外生変数の分散> setwd("d:\\")> d1 <- read.table("拡張SEMデータ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12
1 4 3 2 3 4 4 2 4 2443
2 2 3 2 5 3 4 5 3 3444
3 1 4 2 2 3 3 4 3 2344
4 1 5 2 2 3 2 3 2 2543
5 2 3 1 4 2 1 3 3 2111
6 2 4 3 3 5 4 4 3 4
2
4
1
>
>
329

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean
SD
x1
x2
x3
x4
x5
x6
x7
x8
x9 x10 x11 x12
x1 276 3.01 0.98 1.00 0.28 0.19 0.27 -0.01 0.03 0.11 0.07 0.08 0.06 0.07 0.07
x2 276 3.01 1.03 0.28 1.00 0.22 -0.01 0.02 0.04 0.28 0.06 0.09 0.08 0.09 0.10
x3 276 3.00 0.99 0.19 0.22 1.00 -0.01 0.03 0.01 0.12 0.08 0.09 0.21 0.01 0.07
x4 276 2.99 1.02 0.27 -0.01 -0.01 1.00 0.20 0.23 0.03 0.04 0.02 0.09 0.08 0.08
x5 276 3.00 1.00 -0.01 0.02 0.03 0.20 1.00 0.21 0.05 0.23 0.02 0.08 0.08 0.10
x6 276 3.03 1.04 0.03 0.04 0.01 0.23 0.21 1.00 0.09 0.04 0.07 0.09 0.29 0.11
x7 276 3.03 0.99 0.11 0.28 0.12 0.03 0.05 0.09 1.00 0.21 0.23 0.06 0.05 0.07
x8 276 3.01 1.01 0.07 0.06 0.08 0.04 0.23 0.04 0.21 1.00 0.24 0.09 0.03 0.11
x9 276 3.00 1.01 0.08 0.09 0.09 0.02 0.02 0.07 0.23 0.24 1.00 0.06 0.04 0.22
x10 276 2.99 1.03 0.06 0.08 0.21 0.09 0.08 0.09 0.06 0.09 0.06 1.00 0.17 0.22
x11 276 2.99 1.00 0.07 0.09 0.01 0.08 0.08 0.29 0.05 0.03 0.04 0.17 1.00 0.24
x12 276 2.99 1.01 0.07 0.10 0.07 0.08 0.10 0.11 0.07 0.11 0.22 0.22 0.24 1.00>>
> # 共分散行列・相関係数行列> cov.d1 <- cov(d1)> cor.d1 <- cor(d1)>>> # 適合度指標の設定> library(sem)> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))>> # 2次因子分析モデル> # specifyEqutations を使う方法> seq.1 <- specifyEquations()
1: x1 = 1*f1
2: x2 = b2*f1
3: x3 = b3*f1
4: x4 = 1*f2
5: x5 = b5*f2
6: x6 = b6*f2
7: x7 = 1*f3
8: x8 = b8*f3
9: x9 = b9*f3
10: x10 = 1*f4
11: x11 = b11*f4
12: x12 = b12*f4
13: f1 = a1*f0
14: f2 = a2*f0
15: f3 = a3*f0
16: f4 = a4*f0
17: V(x1) = ev1
18: V(x2) = ev2
19: V(x3) = ev3
20: V(x4) = ev4
21: V(x5) = ev5
22: V(x6) = ev6
23: V(x7) = ev7
24: V(x8) = ev8
25: V(x9) = ev9
26: V(x10) = ev10
27: V(x11) = ev11
28: V(x12) = ev12
29: V(f1) = evf1
30: V(f2) = evf2
31: V(f3) = evf3
32: V(f4) = evf4
33: V(f0) = 1

.76

.69

.84

.81

.82

.73

.77

.79

.75

e1

e2

e3

e4

e5

e6

e7

e8

e9

e 10

e 11

e 12

X1

X2

X3

X4

X5

X6

X7

X8

X9

X 10

X 11

X 12

.49

.55 .40.41.42 .55

.71

d1

.44

d2
.54

.48 .46 .50.42 .52

.71

f1

.61

f2
.54

.82

.46

d3

f3
.62

f0

330

.83

d4

f4

.74

1

X2=85.65, df =50, p=0.001,
AGFI=0.92, RMSEA=0.05,CFI=0.83.70

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

34:
Read 33 items> sem.seq.1 <- sem(seq.1, cor.d1, N=nrow(d1))> summary(sem.seq.1)
Model Chisquare = 85.65067
Df = 50 Pr(>Chisq) = 0.001266141
Goodness-of-fit index = 0.9517556
Adjusted goodness-of-fit index = 0.9247387
RMSEA index = 0.05091931
90% CI: (0.03177626, 0.06890628)
Bentler-Bonett NFI = 0.6892108
Tucker-Lewis NNFI = 0.7754727
Bentler CFI = 0.8299035
Bentler RNI = 0.8299035
Bollen IFI = 0.8419676
SRMR = 0.05468589
AIC = 141.6507
AICc = 92.22557
BIC = -195.3694
CAIC = -245.3694
Normalized Residuals
Min.
1st Qu.
Median-1.324000 -0.502400 -0.070280

Mean
0.004356

3rd Qu.
0.079170

Max.
3.355000

R-square for Endogenous Variables
f1
x1
x2
x3
f2
x4
x5
x6
f3
x7
x8
x9
f4
0.2865 0.2423 0.3053 0.1560 0.2916 0.1916 0.1801 0.2728 0.3863 0.2287 0.2089 0.2466 0.5443
x10
x11
x12
0.1668 0.1788 0.3019
Parameter Estimates
Estimate
Std Error z value Pr(>|z|)b2
1.12236505 0.31882762 3.520288 4.310783e-04 x2 <--- f1
b3
0.80243877 0.23260243 3.449830 5.609404e-04 x3 <--- f1
b5
0.96962859 0.29719961 3.262550 1.104147e-03 x5 <--- f2
b6
1.19327247 0.36553367 3.264467 1.096704e-03 x6 <--- f2
b8
0.95578046 0.26588287 3.594742 3.247126e-04 x8 <--- f3
b9
1.03844772 0.28641767 3.625641 2.882452e-04 x9 <--- f3
b11 1.03524483 0.30551642 3.388508 7.027397e-04 x11 <--- f4
b12 1.34510847 0.38659596 3.479365 5.026034e-04 x12 <--- f4
a1
0.26349329 0.07907821 3.332059 8.620588e-04 f1 <--- f0
a2
0.23636519 0.07530954 3.138582 1.697672e-03 f2 <--- f0
a3
0.29722141 0.08239928 3.607087 3.096533e-04 f3 <--- f0
a4
0.30135388 0.08599659 3.504254 4.578888e-04 f4 <--- f0
ev1 0.75766277 0.09611193 7.883129 3.192835e-15 x1 <--> x1
ev2 0.69472618 0.10557515 6.580395 4.691995e-11 x2 <--> x2
ev3 0.84395663 0.08785998 9.605700 7.564190e-22 x3 <--> x3
ev4 0.80841716 0.09337756 8.657510 4.821806e-18 x4 <--> x4
ev5 0.81987753 0.09215343 8.896875 5.744118e-19 x5 <--> x5
ev6 0.72720477 0.10519623 6.912840 4.750441e-12 x6 <--> x6
ev7 0.77130115 0.09310640 8.284083 1.190226e-16 x7 <--> x7
ev8 0.79108010 0.09122113 8.672115 4.241680e-18 x8 <--> x8
ev9 0.75337806 0.09506220 7.925106 2.279514e-15 x9 <--> x9
ev10 0.83315251 0.08823146 9.442806 3.629282e-21 x10 <--> x10
ev11 0.82118539 0.08896821 9.230099 2.703822e-20 x11 <--> x11
ev12 0.69812194 0.10288119 6.785710 1.155167e-11 x12 <--> x12
evf1 0.17290898 0.07323248 2.361097 1.822097e-02 f1 <--> f1
evf2 0.13571463 0.06402197 2.119814 3.402177e-02 f2 <--> f2
evf3 0.14035790 0.06655606 2.108867 3.495604e-02 f3 <--> f3
evf4 0.07603255 0.04908868 1.548882 1.214102e-01 f4 <--> f4
Iterations =47> stdCoef(sem.seq.1)
Std. Estimate
1
0.4922780
2b20.5525158
3
b3
0.3950230
40.4377020
5b50.4244085

x1 <--- f1
x2 <--- f1
x3 <--- f1
x4 <--- f2
x5 <--- f2331名古屋 大学
6
b6
7
8
b8
9
b9
10
11 b11
12 b12
13
a1
14
a2
15
a3
16
a4
17 ev118 ev219 ev320 ev421 ev522 ev623 ev724 ev825 ev926 ev1027 ev1128 ev1229 evf1
30 evf2
31 evf3
32 evf433

大 学院 教育発 達科 学研 究科・ 教育 学部

0.5222979
x6 <--- f2
0.4782244
x7 <--- f3
0.4570775
x8 <--- f3
0.4966108
x9 <--- f3
0.4084689 x10 <--- f4
0.4228651 x11 <--- f4
0.5494346 x12 <--- f4
0.5352529
f1 <--- f0
0.5400138
f2 <--- f0
0.6215105
f3 <--- f0
0.7377649
f4 <--- f0
0.7576624
x1 <--> x1
0.6947263
x2 <--> x2
0.8439568
x3 <--> x3
0.8084169
x4 <--> x4
0.8198775
x5 <--> x5
0.7272049
x6 <--> x6
0.7713014
x7 <--> x7
0.7910802
x8 <--> x8
0.7533777
x9 <--> x9
0.8331532 x10 <--> x10
0.8211851 x11 <--> x11
0.6981216 x12 <--> x12
0.7135043
f1 <--> f1
0.7083851
f2 <--> f2
0.6137247
f3 <--> f3
0.4557030
f4 <--> f4
1.0000000
f0 <--> f0> # specifyModel を使う方法>> smd.1 <- specifyModel()1: x1 <- f1, NA, 1
2: x2 <- f1, b2, NA
3: x3 <- f1, b3, NA
4: x4 <- f2, NA, 1
5: x5 <- f2, b5, NA
6: x6 <- f2, b6, NA
7: x7 <- f3, NA, 1
8: x8 <- f3, b8, NA
9: x9 <- f3, b9, NA
10: x10 <- f4, NA, 1
11: x11 <- f4, b11, NA
12: x12 <- f4, b12, NA
13: f1 <- f0, a1, NA
14: f2 <- f0, a2, NA
15: f3 <- f0, a3, NA
16: f4 <- f0, a4, NA
17: x1 <-> x1, ev1, NA
18: x2 <-> x2, ev2, NA
19: x3 <-> x3, ev3, NA
20: x4 <-> x4, ev4, NA
21: x5 <-> x5, ev5, NA
22: x6 <-> x6, ev6, NA
23: x7 <-> x7, ev7, NA
24: x8 <-> x8, ev8, NA
25: x9 <-> x9, ev9, NA
26: x10 <-> x10, ev10, NA
27: x11 <-> x11, ev11, NA
28: x12 <-> x12, ev12, NA
29: f1 <-> f1, evf1, NA
30: f2 <-> f2, evf2, NA
31: f3 <-> f3, evf3, NA
32: f4 <-> f4, evf4, NA
33: f0 <-> f0, NA, 1
34:
Read 33 records
NOTE: it is generally simpler to use specifyEquations() or cfa()
see ?specifyEquations332

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> sem.smd.1 <- sem(smd.1, cor.d1, N=nrow(d1))> summary(sem.smd.1)
Model Chisquare = 85.65067
Df = 50 Pr(>Chisq) = 0.001266141
Goodness-of-fit index = 0.9517556
Adjusted goodness-of-fit index = 0.9247387
RMSEA index = 0.05091931
90% CI: (0.03177626, 0.06890628)
Bentler-Bonett NFI = 0.6892108
Tucker-Lewis NNFI = 0.7754727
Bentler CFI = 0.8299035
Bentler RNI = 0.8299035
Bollen IFI = 0.8419676
SRMR = 0.05468589
AIC = 141.6507
AICc = 92.22557
BIC = -195.3694
CAIC = -245.3694
Normalized Residuals
Min.
1st Qu.
Median-1.323649 -0.502359 -0.070289

Mean
0.004357

3rd Qu.
0.079162

Max.
3.355370

R-square for Endogenous Variables
f1
x1
x2
x3
f2
x4
x5
x6
f3
x7
x8
x9
f4
x10
x11
0.2865 0.2423 0.3053 0.1560 0.2916 0.1916 0.1801 0.2728 0.3863 0.2287 0.2089 0.2466 0.5443 0.1668
0.1788x120.3019Parameter Estimates
Estimate
Std Error z value Pr(>|z|)b2
1.12236061 0.31882686 3.520283 4.310874e-04 x2 <--- f1
b3
0.80243848 0.23260259 3.449826 5.609479e-04 x3 <--- f1
b5
0.96962697 0.29719917 3.262549 1.104149e-03 x5 <--- f2
b6
1.19327935 0.36553579 3.264467 1.096704e-03 x6 <--- f2
b8
0.95579306 0.26588655 3.594740 3.247155e-04 x8 <--- f3
b9
1.03845408 0.28641998 3.625634 2.882531e-04 x9 <--- f3
b11 1.03523768 0.30551398 3.388512 7.027306e-04 x11 <--- f4
b12 1.34509840 0.38659218 3.479373 5.025885e-04 x12 <--- f4
a1
0.26349248 0.07907817 3.332051 8.620847e-04 f1 <--- f0
a2
0.23636546 0.07530959 3.138584 1.697664e-03 f2 <--- f0
a3
0.29721792 0.08239879 3.607066 3.096784e-04 f3 <--- f0
a4
0.30135682 0.08599712 3.504267 4.578667e-04 f4 <--- f0
ev1 0.75766236 0.09611213 7.883109 3.193350e-15 x1 <--> x1
ev2 0.69472751 0.10557500 6.580417 4.691305e-11 x2 <--> x2
ev3 0.84395631 0.08786004 9.605690 7.564927e-22 x3 <--> x3
ev4 0.80841789 0.09337746 8.657527 4.821074e-18 x4 <--> x4
ev5 0.81987857 0.09215326 8.896902 5.742696e-19 x5 <--> x5
ev6 0.72720293 0.10519659 6.912800 4.751806e-12 x6 <--> x6
ev7 0.77130333 0.09310612 8.284131 1.189742e-16 x7 <--> x7
ev8 0.79107776 0.09122148 8.672056 4.243862e-18 x8 <--> x8
ev9 0.75337793 0.09506225 7.925101 2.279615e-15 x9 <--> x9
ev10 0.83315180 0.08823161 9.442781 3.630145e-21 x10 <--> x10
ev11 0.82118568 0.08896812 9.230112 2.703498e-20 x11 <--> x11
ev12 0.69812333 0.10288088 6.785744 1.154896e-11 x12 <--> x12
evf1 0.17291004 0.07323286 2.361099 1.822086e-02 f1 <--> f1
evf2 0.13571381 0.06402167 2.119810 3.402204e-02 f2 <--> f2
evf3 0.14035707 0.06655551 2.108872 3.495561e-02 f3 <--> f3
evf4 0.07603244 0.04908910 1.548866 1.214140e-01 f4 <--> f4
Iterations =44> stdCoef(sem.smd.1)
Std. Estimate
1
0.4922785
2
b2
0.5525144
3
b3
0.3950234
40.4377012
5b50.4244070
6
b6
0.5222999

x1 <--- f1
x2 <--- f1
x3 <--- f1
x4 <--- f2
x5 <--- f2
x6 <--- f2
333名古屋 大学
7
8
b8
9
b9
10
11 b11
12 b12
13
a1
14
a2
15
a3
16
a4
17 ev118 ev219 ev320 ev421 ev522 ev623 ev724 ev825 ev926 ev1027 ev1128 ev1229 evf1
30 evf2
31 evf3
32 evf4
33>>

0.4782215
x7 <--- f3
0.4570805
x8 <--- f3
0.4966107
x9 <--- f3
0.4084707 x10 <--- f4
0.4228643 x11 <--- f4
0.5494333 x12 <--- f4
0.5352506
f1 <--- f0
0.5400154
f2 <--- f0
0.6215071
f3 <--- f0
0.7377684
f4 <--- f0
0.7576618
x1 <--> x1
0.6947279
x2 <--> x2
0.8439565
x3 <--> x3
0.8084176
x4 <--> x4
0.8198787
x5 <--> x5
0.7272028
x6 <--> x6
0.7713042
x7 <--> x7
0.7910775
x8 <--> x8
0.7533778
x9 <--> x9
0.8331517 x10 <--> x10
0.8211857 x11 <--> x11
0.6981231 x12 <--> x12
0.7135068
f1 <--> f1
0.7083833
f2 <--> f2
0.6137289
f3 <--> f3
0.4556978
f4 <--> f4
1.0000000
f0 <--> f0

334

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

階層因子分析
library(sem)opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデル名 <- specifyEquations()
構造方程式
sem(モデル名, 共分散行列, N=標本サイズ)
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）

モデル部分のスクリプトの例
seq.1 <- specifyEquations()
x1 = 1*f0# 測定方程式
x2 = g2*f0
x3 = g3*f0
x4 = g4*f0
x5 = g5*f0
x6 = g6*f0
x7 = g7*f0
x8 = g8*f0
x9 = g9*f0
x10 = g10*f0
x11 = g11*f0
x12 = g12*f0
x1 = 1*f1
x2 = b2*f1
x3 = b3*f1
x4 = 1*f2
x5 = b5*f2
x6 = b6*f2
x7 = 1*f3
x8 = b8*f3
x9 = b9*f3
x10 = 1*f4
x11 = b11*f4
x12 = b12*f4
V(x1) = ev1# 内生変数の誤差分散
V(x2) = ev2
V(x3) = ev3
V(x4) = ev4
V(x5) = ev5
V(x6) = ev6
V(x7) = ev7
V(x8) = ev8
V(x9) = ev9
V(x10) = ev10
V(x11) = ev11
V(x12) = ev12
V(f0) = vf0# 外生変数の分散
V(f1) = vf1
V(f2) = vf2
V(f3) = vf3
V(f4) = vf4335

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("拡張SEMデータ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12
1 4 3 2 3 4 4 2 4 2443
2 2 3 2 5 3 4 5 3 3444
3 1 4 2 2 3 3 4 3 2344
4 1 5 2 2 3 2 3 2 2543
5 2 3 1 4 2 1 3 3 2111
6 2 4 3 3 5 4 4 3 4
2
4
1
>
>
> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean
SD
x1
x2
x3
x4
x5
x6
x7
x8
x9 x10 x11 x12
x1 276 3.01 0.98 1.00 0.28 0.19 0.27 -0.01 0.03 0.11 0.07 0.08 0.06 0.07 0.07
x2 276 3.01 1.03 0.28 1.00 0.22 -0.01 0.02 0.04 0.28 0.06 0.09 0.08 0.09 0.10
x3 276 3.00 0.99 0.19 0.22 1.00 -0.01 0.03 0.01 0.12 0.08 0.09 0.21 0.01 0.07
x4 276 2.99 1.02 0.27 -0.01 -0.01 1.00 0.20 0.23 0.03 0.04 0.02 0.09 0.08 0.08
x5 276 3.00 1.00 -0.01 0.02 0.03 0.20 1.00 0.21 0.05 0.23 0.02 0.08 0.08 0.10
x6 276 3.03 1.04 0.03 0.04 0.01 0.23 0.21 1.00 0.09 0.04 0.07 0.09 0.29 0.11
x7 276 3.03 0.99 0.11 0.28 0.12 0.03 0.05 0.09 1.00 0.21 0.23 0.06 0.05 0.07
x8 276 3.01 1.01 0.07 0.06 0.08 0.04 0.23 0.04 0.21 1.00 0.24 0.09 0.03 0.11
x9 276 3.00 1.01 0.08 0.09 0.09 0.02 0.02 0.07 0.23 0.24 1.00 0.06 0.04 0.22
x10 276 2.99 1.03 0.06 0.08 0.21 0.09 0.08 0.09 0.06 0.09 0.06 1.00 0.17 0.22
x11 276 2.99 1.00 0.07 0.09 0.01 0.08 0.08 0.29 0.05 0.03 0.04 0.17 1.00 0.24
x12 276 2.99 1.01 0.07 0.10 0.07 0.08 0.10 0.11 0.07 0.11 0.22 0.22 0.24 1.00>>
> # 共分散行列・相関係数行列> cov.d1 <- cov(d1)> cor.d1 <- cor(d1)>> # 適合度指標の設定> library(sem)> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))> # 階層因子分析> # specifyEquations を使う方法> seq.1 <- specifyEquations()
1: x1 = 1*f0
2: x2 = g2*f0
3: x3 = g3*f0
4: x4 = g4*f0
5: x5 = g5*f0
6: x6 = g6*f0
7: x7 = g7*f0
8: x8 = g8*f0
9: x9 = g9*f0
10: x10 = g10*f0
11: x11 = g11*f0
12: x12 = g12*f0
13: x1 = 1*f1
14: x2 = b2*f1
15: x3 = b3*f1
16: x4 = 1*f2
17: x5 = b5*f2
18: x6 = b6*f2
19: x7 = 1*f3
20: x8 = b8*f3
21: x9 = b9*f3
22: x10 = 1*f4
23: x11 = b11*f4
336

名古屋 大学
24: x12 = b12*f4
25: V(x1) = ev1
26: V(x2) = ev2
27: V(x3) = ev3
28: V(x4) = ev4
29: V(x5) = ev5
30: V(x6) = ev6
31: V(x7) = ev7
32: V(x8) = ev8
33: V(x9) = ev9
34: V(x10) = ev10
35: V(x11) = ev11
36: V(x12) = ev12
37: V(f0) = vf0
38: V(f1) = vf1
39: V(f2) = vf2
40: V(f3) = vf3
41: V(f4) = vf4
42:
Read 41 items

大 学院 教育発 達科 学研 究科・ 教育 学部
f0

e1
.75

X1
.43

e2
.69

.31 .24

e3

e4

.85

X3

X2
.46

.24

.30

f1

.19

.22 .30.34 .27 .30

e6

e7
.78

.78

.74

.84

.83

.68

X7

X8

X9

X 10

X 11

X 12

.32

.38 .41

e5

.78

.82

.75

X4

X5

X6

.43

.36 .40

f2
1

1

.31

e8

.31 .38

e9

e 10

.25

1

.42

1

X2=84.88, df =42, p=0.000,
AGFI=0.91, RMSEA=0.06,CFI=0.80> sem.seq.1 <- sem(seq.1, cor.d1, N=nrow(d1))> summary(sem.seq.1)
Model Chisquare = 84.87574
Df = 42 Pr(>Chisq) = 0.0001000983
Goodness-of-fit index = 0.9520337
Adjusted goodness-of-fit index = 0.9109198
RMSEA index = 0.06092771
90% CI: (0.04201327, 0.07957644)
Bentler-Bonett NFI = 0.6920227
Tucker-Lewis NNFI = 0.6785349
Bentler CFI = 0.7954313
Bentler RNI = 0.7954313
Bollen IFI = 0.8164494
SRMR = 0.05440171
AIC = 156.8757
AICc = 96.02218
BIC = -151.1811
CAIC = -193.1811
Normalized Residuals
Min.
1st Qu.
Median-1.162000 -0.515000 -0.000003

.28

e 12

f4

f3
1

e 11

Mean
0.007099

3rd Qu.
0.114000

Max.
3.619000

R-square for Endogenous Variables
x1
x2
x3
x4
x5
x6
x7
x8
x9
x10
x11
x12
0.2472 0.3110 0.1505 0.2199 0.1816 0.2499 0.2161 0.2190 0.2578 0.1605 0.1740 0.3222
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)g2
1.29135922 0.54095766 2.3871724 1.697853e-02 x2 <--- f0
g3
0.99690472 0.49167286 2.0275773 4.260341e-02 x3 <--- f0
g4
0.78741917 0.48920720 1.6095821 1.074891e-01 x4 <--- f0
g5
0.91272533 0.52099931 1.7518743 7.979542e-02 x5 <--- f0
g6
1.22850988 0.61104494 2.0105066 4.437760e-02 x6 <--- f0
g7
1.38467477 0.67510479 2.0510516 4.026192e-02 x7 <--- f0
g8
1.11298070 0.59188925 1.8803867 6.005539e-02 x8 <--- f0
g9
1.22321784 0.62477690 1.9578474 5.024792e-02 x9 <--- f0
g10 1.27907696 0.66230766 1.9312429 5.345302e-02 x10 <--- f0
g11 1.28682031 0.66474566 1.9358085 5.289116e-02 x11 <--- f0
g12 1.57710061 0.75977537 2.0757459 3.791746e-02 x12 <--- f0
b2
1.06257658 0.57743364 1.8401709 6.574315e-02 x2 <--- f1
b3
0.69852725 0.34116593 2.0474707 4.061189e-02 x3 <--- f1
b5
0.84997034 0.42085261 2.0196390 4.342085e-02 x5 <--- f2
b6
0.93630730 0.47147606 1.9859063 4.704372e-02 x6 <--- f2
b8
1.19114999 0.65045685 1.8312514 6.706303e-02 x8 <--- f3
b9
1.28362651 0.72323231 1.7748468 7.592319e-02 x9 <--- f3
b11 1.09241118 0.81574961 1.3391501 1.805218e-01 x11 <--- f4
b12 1.65701217 1.56272829 1.0603329 2.889932e-01 x12 <--- f4
ev1 0.75275907 0.12073054 6.2350345 4.516784e-10 x1 <--> x1
ev2 0.68901691 0.12894638 5.3434373 9.120039e-08 x2 <--> x2
ev3 0.84946057 0.08810750 9.6411836 5.356673e-22 x3 <--> x3
337

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ev4 0.78010109 0.11771440 6.6270657 3.424252e-11 x4 <--> x4
ev5 0.81837082 0.09834969 8.3210311 8.720140e-17 x5 <--> x5
ev6 0.75014350 0.10644641 7.0471472 1.826231e-12 x6 <--> x6
ev7 0.78389751 0.09218653 8.5033845 1.841417e-17 x7 <--> x7
ev8 0.78095991 0.11017349 7.0884557 1.356168e-12 x8 <--> x8
ev9 0.74221679 0.11985096 6.1928315 5.909289e-10 x9 <--> x9
ev10 0.83950483 0.09328963 8.9989086 2.279727e-19 x10 <--> x10
ev11 0.82599502 0.09980138 8.2763884 1.269674e-16 x11 <--> x11
ev12 0.67782658 0.17379263 3.9002033 9.611194e-05 x12 <--> x12
vf0 0.05910628 0.04561604 1.2957345 1.950670e-01 f0 <--> f0
vf1 0.18813468 0.12082629 1.5570675 1.194545e-01 f1 <--> f1
vf2 0.18325112 0.11428279 1.6034883 1.088269e-01 f2 <--> f2
vf3 0.10277668 0.08120992 1.2655680 2.056678e-01 f3 <--> f3
vf4 0.06379509 0.07930956 0.8043808 4.211771e-01 f4 <--> f4
Iterations =162> stdCoef(sem.seq.1)
Std. Estimate
10.2431178
x1 <--- f02
g2
0.3139524
x2 <--- f03
g3
0.2423653
x3 <--- f04
g4
0.1914357
x4 <--- f05
g5
0.2218998
x5 <--- f0
6
g6
0.2986727
x6 <--- f07
g7
0.3366391
x7 <--- f08
g8
0.2705855
x8 <--- f09
g90.2973861
x9 <--- f0
10 g100.3109664 x10 <--- f0
11 g110.3128489 x11 <--- f0
12 g120.3834213 x12 <--- f013
0.4337449
x1 <--- f1
14b2
0.4608872
x2 <--- f1
15
b3
0.3029827
x3 <--- f1
16
0.4280784
x4 <--- f2
17
b5
0.3638539
x5 <--- f2
18
b6
0.4008130
x6 <--- f2
19
0.3205880
x7 <--- f3
20
b8
0.3818684
x8 <--- f3
21b9
0.4115153
x9 <--- f3
22
0.2525769 x10 <--- f4
23 b110.2759178 x11 <--- f4
24 b120.4185230 x12 <--- f4
25 ev10.7527590
x1 <--> x1
26 ev20.6890169
x2 <--> x2
27 ev30.8494606
x3 <--> x3
28 ev40.7801012
x4 <--> x4
29 ev50.8183708
x5 <--> x5
30 ev60.7501436
x6 <--> x6
31 ev70.7838974
x7 <--> x7
32 ev80.7809600
x8 <--> x8
33 ev90.7422167
x9 <--> x9
34 ev100.8395048 x10 <--> x10
35 ev110.8259949 x11 <--> x11
36 ev120.6778266 x12 <--> x12
37 vf01.0000000
f0 <--> f0
38 vf11.0000000
f1 <--> f1
39 vf21.0000000
f2 <--> f2
40 vf31.0000000
f3 <--> f3
41 vf41.0000000
f4 <--> f4338

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # specifyModel を使う方法>> smd.1 <- specifyModel()1: x1 <- f0, NA, 1
2: x2 <- f0, g2, NA
3: x3 <- f0, g3, NA
4: x4 <- f0, g4, NA
5: x5 <- f0, g5, NA
6: x6 <- f0, g6, NA
7: x7 <- f0, g7, NA
8: x8 <- f0, g8, NA
9: x9 <- f0, g9, NA
10: x10 <- f0, g10, NA
11: x11 <- f0, g11, NA
12: x12 <- f0, g12, NA
13: x1 <- f1, NA, 1
14: x2 <- f1, b2, NA
15: x3 <- f1, b3, NA
16: x4 <- f2, NA, 1
17: x5 <- f2, b5, NA
18: x6 <- f2, b6, NA
19: x7 <- f3, NA, 1
20: x8 <- f3, b8, NA
21: x9 <- f3, b9, NA
22: x10 <- f4, NA, 1
23: x11 <- f4, b11, NA
24: x12 <- f4, b12, NA
25: x1 <-> x1, ev1, NA
26: x2 <-> x2, ev2, NA
27: x3 <-> x3, ev3, NA
28: x4 <-> x4, ev4, NA
29: x5 <-> x5, ev5, NA
30: x6 <-> x6, ev6, NA
31: x7 <-> x7, ev7, NA
32: x8 <-> x8, ev8, NA
33: x9 <-> x9, ev9, NA
34: x10 <-> x10, ev10, NA
35: x11 <-> x11, ev11, NA
36: x12 <-> x12, ev12, NA
37: f0 <-> f0, vf0, NA
38: f1 <-> f1, vf1, NA
39: f2 <-> f2, vf2, NA
40: f3 <-> f3, vf3, NA
41: f4 <-> f4, vf4, NA
42:
Read 41 records
NOTE: it is generally simpler to use specifyEquations() or cfa()
see ?specifyEquations> sem.smd.1 <- sem(smd.1, cor.d1, N=nrow(d1))> summary(sem.smd.1)
Model Chisquare = 84.87574
Df = 42 Pr(>Chisq) = 0.0001000983
Goodness-of-fit index = 0.9520337
Adjusted goodness-of-fit index = 0.9109198
RMSEA index = 0.06092771
90% CI: (0.04201327, 0.07957644)
Bentler-Bonett NFI = 0.6920227
Tucker-Lewis NNFI = 0.6785349
Bentler CFI = 0.7954313
Bentler RNI = 0.7954313
Bollen IFI = 0.8164494
SRMR = 0.05440171
AIC = 156.8757
AICc = 96.02218
BIC = -151.1811
CAIC = -193.1811
Normalized Residuals
Min.
1st Qu.
Median-1.162275 -0.514983 -0.000003

Mean
0.007099

3rd Qu.
0.113998
339

Max.
3.618960

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

R-square for Endogenous Variables
x1
x2
x3
x4
x5
x6
x7
x8
x9
x10
x11
x12
0.2472 0.3110 0.1505 0.2199 0.1816 0.2499 0.2161 0.2190 0.2578 0.1605 0.1740 0.3222
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)g2
1.29135922 0.54095766 2.3871724 1.697853e-02 x2 <--- f0
g3
0.99690472 0.49167286 2.0275773 4.260341e-02 x3 <--- f0
g4
0.78741917 0.48920720 1.6095821 1.074891e-01 x4 <--- f0
g5
0.91272533 0.52099931 1.7518743 7.979542e-02 x5 <--- f0
g6
1.22850988 0.61104494 2.0105066 4.437760e-02 x6 <--- f0
g7
1.38467477 0.67510479 2.0510516 4.026192e-02 x7 <--- f0
g8
1.11298070 0.59188925 1.8803867 6.005539e-02 x8 <--- f0
g9
1.22321784 0.62477690 1.9578474 5.024792e-02 x9 <--- f0
g10 1.27907696 0.66230766 1.9312429 5.345302e-02 x10 <--- f0
g11 1.28682031 0.66474566 1.9358085 5.289116e-02 x11 <--- f0
g12 1.57710061 0.75977537 2.0757459 3.791746e-02 x12 <--- f0
b2
1.06257658 0.57743364 1.8401709 6.574315e-02 x2 <--- f1
b3
0.69852725 0.34116593 2.0474707 4.061189e-02 x3 <--- f1
b5
0.84997034 0.42085261 2.0196390 4.342085e-02 x5 <--- f2
b6
0.93630730 0.47147606 1.9859063 4.704372e-02 x6 <--- f2
b8
1.19114999 0.65045685 1.8312514 6.706303e-02 x8 <--- f3
b9
1.28362651 0.72323231 1.7748468 7.592319e-02 x9 <--- f3
b11 1.09241118 0.81574961 1.3391501 1.805218e-01 x11 <--- f4
b12 1.65701217 1.56272829 1.0603329 2.889932e-01 x12 <--- f4
ev1 0.75275907 0.12073054 6.2350345 4.516784e-10 x1 <--> x1
ev2 0.68901691 0.12894638 5.3434373 9.120039e-08 x2 <--> x2
ev3 0.84946057 0.08810750 9.6411836 5.356673e-22 x3 <--> x3
ev4 0.78010109 0.11771440 6.6270657 3.424252e-11 x4 <--> x4
ev5 0.81837082 0.09834969 8.3210311 8.720140e-17 x5 <--> x5
ev6 0.75014350 0.10644641 7.0471472 1.826231e-12 x6 <--> x6
ev7 0.78389751 0.09218653 8.5033845 1.841417e-17 x7 <--> x7
ev8 0.78095991 0.11017349 7.0884557 1.356168e-12 x8 <--> x8
ev9 0.74221679 0.11985096 6.1928315 5.909289e-10 x9 <--> x9
ev10 0.83950483 0.09328963 8.9989086 2.279727e-19 x10 <--> x10
ev11 0.82599502 0.09980138 8.2763884 1.269674e-16 x11 <--> x11
ev12 0.67782658 0.17379263 3.9002033 9.611194e-05 x12 <--> x12
vf0 0.05910628 0.04561604 1.2957345 1.950670e-01 f0 <--> f0
vf1 0.18813468 0.12082629 1.5570675 1.194545e-01 f1 <--> f1
vf2 0.18325112 0.11428279 1.6034883 1.088269e-01 f2 <--> f2
vf3 0.10277668 0.08120992 1.2655680 2.056678e-01 f3 <--> f3
vf4 0.06379509 0.07930956 0.8043808 4.211771e-01 f4 <--> f4
Iterations =162> stdCoef(sem.smd.1)
Std. Estimate
10.2431178
2
g2
0.3139524
3
g3
0.2423653
4g40.1914357
5g50.2218998
6
g6
0.2986727
7
g7
0.3366391
8g80.2705855
9g90.2973861
10 g100.3109664
11 g110.3128489
12 g120.3834213
13
0.4337449
14b2
0.4608872
15b30.3029827
16
0.4280784
17b50.3638539
18b6
0.4008130
190.3205880
20b8
0.3818684
21b9
0.4115153
220.2525769
23 b110.2759178
24 b120.4185230

x1 <--- f0
x2 <--- f0
x3 <--- f0
x4 <--- f0
x5 <--- f0
x6 <--- f0
x7 <--- f0
x8 <--- f0
x9 <--- f0
x10 <--- f0
x11 <--- f0
x12 <--- f0
x1 <--- f1
x2 <--- f1
x3 <--- f1
x4 <--- f2
x5 <--- f2
x6 <--- f2
x7 <--- f3
x8 <--- f3
x9 <--- f3
x10 <--- f4
x11 <--- f4
x12 <--- f4340名古屋 大学
25 ev126 ev227 ev328 ev429 ev530 ev631 ev732 ev833 ev934 ev1035 ev1136 ev1237 vf038 vf1
39 vf240 vf341 vf40.7527590
x1 <--> x1
0.6890169
x2 <--> x2
0.8494606
x3 <--> x3
0.7801012
x4 <--> x4
0.8183708
x5 <--> x5
0.7501436
x6 <--> x6
0.7838974
x7 <--> x7
0.7809600
x8 <--> x8
0.7422167
x9 <--> x9
0.8395048 x10 <--> x10
0.8259949 x11 <--> x11
0.6778266 x12 <--> x12
1.0000000
f0 <--> f0
1.0000000
f1 <--> f1
1.0000000
f2 <--> f2
1.0000000
f3 <--> f3
1.0000000
f4 <--> f4341

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多重指標モデルlibrary(sem)opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデル名 <- specifyEquations()
構造方程式
sem(モデル名, 共分散(相関)行列, N=標本サイズ)
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）

モデル部分のスクリプトの例
seq.1 <- specifyEquations()
x1 = 1*f1
x2 = b2*f1
x3 = b3*f1
x7 = 1*f3
x8 = b8*f3
x9 = b9*f3
f3 = a31*f1
V(x1) = ev1
V(x2) = ev2
V(x3) = ev3
V(x7) = ev7
V(x8) = ev8
V(x9) = ev9
V(f3) = evf3
V(f1) = vf1

d3
e1

x1

e2

x2

e3

x3

f1

f3

x7

e7

x8

e8

x9

e9

> setwd("d:\\")> d1 <- read.table("拡張SEMデータ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12
1 4 3 2 3 4 4 2 4 2443
2 2 3 2 5 3 4 5 3 3444
3 1 4 2 2 3 3 4 3 2344
4 1 5 2 2 3 2 3 2 2543
5 2 3 1 4 2 1 3 3 2111
6 2 4 3 3 5 4 4 3 4
2
4
1
>
>
> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean
SD
x1
x2
x3
x4
x5
x6
x7
x8
x9 x10 x11 x12
x1 276 3.01 0.98 1.00 0.28 0.19 0.27 -0.01 0.03 0.11 0.07 0.08 0.06 0.07 0.07
x2 276 3.01 1.03 0.28 1.00 0.22 -0.01 0.02 0.04 0.28 0.06 0.09 0.08 0.09 0.10
x3 276 3.00 0.99 0.19 0.22 1.00 -0.01 0.03 0.01 0.12 0.08 0.09 0.21 0.01 0.07
x4 276 2.99 1.02 0.27 -0.01 -0.01 1.00 0.20 0.23 0.03 0.04 0.02 0.09 0.08 0.08342

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

x5 276 3.00 1.00 -0.01 0.02 0.03 0.20 1.00 0.21 0.05 0.23 0.02 0.08 0.08 0.10
x6 276 3.03 1.04 0.03 0.04 0.01 0.23 0.21 1.00 0.09 0.04 0.07 0.09 0.29 0.11
x7 276 3.03 0.99 0.11 0.28 0.12 0.03 0.05 0.09 1.00 0.21 0.23 0.06 0.05 0.07
x8 276 3.01 1.01 0.07 0.06 0.08 0.04 0.23 0.04 0.21 1.00 0.24 0.09 0.03 0.11
x9 276 3.00 1.01 0.08 0.09 0.09 0.02 0.02 0.07 0.23 0.24 1.00 0.06 0.04 0.22
x10 276 2.99 1.03 0.06 0.08 0.21 0.09 0.08 0.09 0.06 0.09 0.06 1.00 0.17 0.22
x11 276 2.99 1.00 0.07 0.09 0.01 0.08 0.08 0.29 0.05 0.03 0.04 0.17 1.00 0.24
x12 276 2.99 1.01 0.07 0.10 0.07 0.08 0.10 0.11 0.07 0.11 0.22 0.22 0.24 1.00>>
> # 共分散行列・相関係数行列> cov.d1 <- cov(d1)> cor.d1 <- cor(d1)>>> # 多重指標モデル> library(sem)> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))
seq.1 <- specifyEquations()
1: x1 = 1*f1
2: x2 = b2*f1
3: x3 = b3*f1
4: x7 = 1*f3
5: x8 = b8*f3
6: x9 = b9*f3
7: f3 = a31*f1
8: V(x1) = ev1
9: V(x2) = ev2
10: V(x3) = ev3
11: V(x7) = ev7
12: V(x8) = ev8
13: V(x9) = ev9
14: V(f3) = evf3
15: V(f1) = vf1
16:
Read 15 items> sem.seq.1 <- sem(seq.1, cov.d1, N=nrow(d1))> summary(sem.seq.1)
Model Chisquare = 9.187096
Df = 8 Pr(>Chisq) = 0.3267596
Goodness-of-fit index = 0.9885242
Adjusted goodness-of-fit index = 0.969876
RMSEA index = 0.02322905
90% CI: (NA, 0.07683467)
Bentler-Bonett NFI = 0.9125166
Tucker-Lewis NNFI = 0.975273
Bentler CFI = 0.9868123
Bentler RNI = 0.9868123
Bollen IFI = 0.9877638
SRMR = 0.03268035
AIC = 35.1871
AICc = 10.57641
BIC = -35.77611
CAIC = -43.77611
Normalized Residuals
Min.
1st Qu.
MedianMean-1.123000 -0.332200 -0.005191 -0.031210

3rd Qu.
0.056290

Max.
1.362000

R-square for Endogenous Variables
x1
x2
x3
f3
x7
x8
x9
0.1912 0.3961 0.1360 0.2738 0.3787 0.1409 0.1694
Parameter Estimates
Estimate Std Error z value
Pr(>|z|)b2
1.5186975 0.43869639 3.461842 5.364926e-04 x2 <--- f1
b3
0.8561944 0.25021723 3.421804 6.220703e-04 x3 <--- f1
b8
0.6234700 0.19324808 3.226267 1.254161e-03 x8 <--- f3
b9
0.6838182 0.20630464 3.314604 9.177304e-04 x9 <--- f3
a31 0.7444214 0.23023345 3.233333 1.223549e-03 f3 <--- f1343

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ev1 0.7762467 0.08607366 9.018401 1.908553e-19 x1 <--> x1
ev2 0.6455500 0.13005700 4.963593 6.920086e-07 x2 <--> x2
ev3 0.8545419 0.08520639 10.029082 1.135676e-23 x3 <--> x3
ev7 0.6094471 0.11954549 5.098035 3.431974e-07 x7 <--> x7
ev8 0.8808253 0.08941441 9.851044 6.783564e-23 x8 <--> x8
ev9 0.8517256 0.09136838 9.321886 1.142907e-20 x9 <--> x9
evf3 0.2698155 0.11038347 2.444347 1.451145e-02 f3 <--> f3
vf1 0.1835426 0.07310119 2.510801 1.204575e-02 f1 <--> f1
Iterations = 31
> stdCoef(sem.seq.1)
Std. Estimate
10.4373010 x1 <--- f12
b2
0.6293252 x2 <--- f1
3
b3
0.3688269 x3 <--- f1
4
0.6154132 x7 <--- f3
5
b8
0.3753166 x8 <--- f3
6
b9
0.4116027 x9 <--- f37
a31
0.5232285 f3 <--- f1
8
ev1
0.8087679 x1 <--> x1
9ev2
0.6039498 x2 <--> x2
10 ev30.8639667 x3 <--> x3
11 ev70.6212666 x7 <--> x7
12 ev80.8591374 x8 <--> x8
13 ev90.8305832 x9 <--> x9
14 evf3
0.7262319 f3 <--> f3
15 vf11.0000000 f1 <--> f1
>
>
>
>
.81
.60

e1
e2

X1
X2

d3

.44

1

.63

f1

.37
.86

e3

.52

f3

.73
.62
.78

X7

e 7 .62X8

e 8 .86X9e 9 .83.41

X3

X2=9.19, df =8, p=0.327,
AGFI=0.97, RMSEA=0.02,CFI=0.99

344

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

潜在変数の構造方程式モデリング ― semパッケージ
library(sem)opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデル名 <- specifyEquations()
構造方程式
sem(モデル名, 共分散(相関)行列, N=標本サイズ)
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）

モデル部分のスクリプトの例
seq.1 <- specifyEquations()
x1 = 1*f1# 測定方程式
x2 = b2*f1
x3 = b3*f1
x4 = 1*f2
x5 = b5*f2
x6 = b6*f2
x7 = 1*f3
x8 = b8*f3
x9 = b9*f3
x10 = 1*f4
x11 = b11*f4
x12 = b12*f4
f3 = a31*f1# 潜在変数間の予測式
f4 = a41*f1 + a42*f2
V(x1) = ev1# 内生変数の誤差分散
V(x2) = ev2
V(x3) = ev3
V(x4) = ev4
V(x5) = ev5
V(x6) = ev6
V(x7) = ev7
V(x8) = ev8
V(x9) = ev9
V(x10) = ev10
V(x11) = ev11
V(x12) = ev12
V(f3) = evf3
V(f4) = evf4
V(f1) = vf1# 外生変数の分散
V(f2) = vf2
C(f1,f2) = cf12
# 外生変数の共分散> setwd("d:\\")> d1 <- read.table("拡張SEMデータ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12
1 4 3 2 3 4 4 2 4 2443
2 2 3 2 5 3 4 5 3 3444
3 1 4 2 2 3 3 4 3 2344
4 1 5 2 2 3 2 3 2 2543
5 2 3 1 4 2 1 3 3 2111
6 2 4 3 3 5 4 4 3 4
2
4
1
>
>
345

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean
SD
x1
x2
x3
x4
x5
x6
x7
x8
x9 x10 x11 x12
x1 276 3.01 0.98 1.00 0.28 0.19 0.27 -0.01 0.03 0.11 0.07 0.08 0.06 0.07 0.07
x2 276 3.01 1.03 0.28 1.00 0.22 -0.01 0.02 0.04 0.28 0.06 0.09 0.08 0.09 0.10
x3 276 3.00 0.99 0.19 0.22 1.00 -0.01 0.03 0.01 0.12 0.08 0.09 0.21 0.01 0.07
x4 276 2.99 1.02 0.27 -0.01 -0.01 1.00 0.20 0.23 0.03 0.04 0.02 0.09 0.08 0.08
x5 276 3.00 1.00 -0.01 0.02 0.03 0.20 1.00 0.21 0.05 0.23 0.02 0.08 0.08 0.10
x6 276 3.03 1.04 0.03 0.04 0.01 0.23 0.21 1.00 0.09 0.04 0.07 0.09 0.29 0.11
x7 276 3.03 0.99 0.11 0.28 0.12 0.03 0.05 0.09 1.00 0.21 0.23 0.06 0.05 0.07
x8 276 3.01 1.01 0.07 0.06 0.08 0.04 0.23 0.04 0.21 1.00 0.24 0.09 0.03 0.11
x9 276 3.00 1.01 0.08 0.09 0.09 0.02 0.02 0.07 0.23 0.24 1.00 0.06 0.04 0.22
x10 276 2.99 1.03 0.06 0.08 0.21 0.09 0.08 0.09 0.06 0.09 0.06 1.00 0.17 0.22
x11 276 2.99 1.00 0.07 0.09 0.01 0.08 0.08 0.29 0.05 0.03 0.04 0.17 1.00 0.24
x12 276 2.99 1.01 0.07 0.10 0.07 0.08 0.10 0.11 0.07 0.11 0.22 0.22 0.24 1.00>>
> # 共分散行列・相関係数行列> cov.d1 <- cov(d1)> cor.d1 <- cor(d1)>>> # 因子間構造モデル> library(sem)> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI", "SRM
R", "AIC", "AICc", "BIC", "CAIC"))>> seq.1 <- specifyEquations()
1: x1 = 1*f1
2: x2 = b2*f1
3: x3 = b3*f1
4: x4 = 1*f2
5: x5 = b5*f2
6: x6 = b6*f2
7: x7 = 1*f3
8: x8 = b8*f3
9: x9 = b9*f3
10: x10 = 1*f4
11: x11 = b11*f4
12: x12 = b12*f4
13: f3 = a31*f1
14: f4 = a41*f1 + a42*f2
15: V(x1) = ev1
16: V(x2) = ev2
17: V(x3) = ev3
18: V(x4) = ev4
19: V(x5) = ev5
20: V(x6) = ev6
21: V(x7) = ev7
22: V(x8) = ev8
23: V(x9) = ev9
24: V(x10) = ev10
25: V(x11) = ev11
26: V(x12) = ev12
27: V(f3) = evf3
28: V(f4) = evf4
29: V(f1) = vf1
30: V(f2) = vf2
31: C(f1,f2) = cf12
32:
Read 31 items> sem.seq.1 <- sem(seq.1, cor.d1, N=nrow(d1))> summary(sem.seq.1)346名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Model Chisquare = 83.02649
Df = 50 Pr(>Chisq) = 0.002305156
Goodness-of-fit index = 0.953118
Adjusted goodness-of-fit index = 0.9268641
RMSEA index = 0.04900945
90% CI: (0.02933125, 0.06721064)
Bentler-Bonett NFI = 0.6987328
Tucker-Lewis NNFI = 0.7919997
Bentler CFI = 0.842424
Bentler RNI = 0.842424
Bollen IFI = 0.8536001
SRMR = 0.05428159
AIC = 139.0265
AICc = 89.60139
BIC = -197.9936
CAIC = -247.9936
Normalized Residuals
Min. 1st Qu. Median-1.1980 -0.4154 -0.1110

Mean 3rd Qu.
0.1063 0.2682

Max.
3.7710R-square for Endogenous Variables
x1
x2
x3
x4
x5
x6
f3
x7
x8
x9
f4
x10
x11
0.2005 0.3366 0.1483 0.1676 0.1510 0.3358 0.3151 0.3396 0.1550 0.1890 0.3986 0.1587 0.2398
x12
0.2356
Parameter Estimates
Estimate
Std Error z value Pr(>|z|)b2
1.29569918 0.34075086 3.802482 1.432534e-04 x2 <--- f1
b3
0.86015848 0.24459171 3.516712 4.369283e-04 x3 <--- f1
b5
0.94917157 0.29318375 3.237463 1.205975e-03 x5 <--- f2
b6
1.41554193 0.43270252 3.271397 1.070174e-03 x6 <--- f2
b8
0.67557465 0.19781491 3.415186 6.373854e-04 x8 <--- f3
b9
0.74592556 0.21220194 3.515168 4.394752e-04 x9 <--- f3
b11 1.22951694 0.35459376 3.467396 5.255274e-04 x11 <--- f4
b12 1.21854597 0.35180875 3.463660 5.328791e-04 x12 <--- f4
a31 0.73053457 0.22194276 3.291545 9.963869e-04 f3 <--- f1
a41 0.26687006 0.13446825 1.984633 4.718537e-02 f4 <--- f1
a42 0.48420288 0.19075744 2.538317 1.113870e-02 f4 <--- f2
ev1 0.79951327 0.08802143 9.083166 1.054612e-19 x1 <--> x1
ev2 0.66341533 0.10181173 6.516099 7.215927e-11 x2 <--> x2
ev3 0.85166528 0.08572231 9.935165 2.926898e-23 x3 <--> x3
ev4 0.83243627 0.08985916 9.263788 1.973045e-20 x4 <--> x4
ev5 0.84903732 0.08863006 9.579564 9.745538e-22 x5 <--> x5
ev6 0.66424202 0.11484738 5.783693 7.307822e-09 x6 <--> x6
ev7 0.66040641 0.10968439 6.020970 1.733749e-09 x7 <--> x7
ev8 0.84500901 0.08741897 9.666197 4.196854e-22 x8 <--> x8
ev9 0.81104876 0.08962717 9.049139 1.440999e-19 x9 <--> x9
ev10 0.84134121 0.08760173 9.604162 7.678009e-22 x10 <--> x10
ev11 0.76015347 0.09371818 8.111057 5.018146e-16 x11 <--> x11
ev12 0.76441388 0.09327267 8.195475 2.496052e-16 x12 <--> x12
evf3 0.23259733 0.09569770 2.430542 1.507624e-02 f3 <--> f3
evf4 0.09541110 0.04785396 1.993797 4.617419e-02 f4 <--> f4
vf1 0.20048687 0.07564876 2.650234 8.043615e-03 f1 <--> f1
vf2 0.16756383 0.07258184 2.308619 2.096472e-02 f2 <--> f2
cf12 0.03747028 0.02461593 1.522197 1.279598e-01 f2 <--> f1
Iterations =47> stdCoef(sem.seq.1)
Std. Estimate
10.4477576
2
b2
0.5801592
3
b3
0.3851425
40.4093456
5
b5
0.3885392
6
b6
0.5794460
70.5827464
8b80.3936887
9b90.4346854
100.3983204
11 b11
0.4897417
12 b120.4853719

x1 <--- f1
x2 <--- f1
x3 <--- f1
x4 <--- f2
x5 <--- f2
x6 <--- f2
x7 <--- f3
x8 <--- f3
x9 <--- f3
x10 <--- f4
x11 <--- f4
x12 <--- f4347

名古屋 大学
13 a31
14 a41
15 a4216 ev117 ev218 ev319 ev420 ev521 ev622 ev723 ev824 ev925 ev1026 ev1127 ev1228 evf3
29 evf4
30 vf1
31 vf232 cf12>>>

大 学院 教育発 達科 学研 究科・ 教育 学部

0.5613118
f3 <--- f1
0.2999924
f4 <--- f1
0.4976051
f4 <--- f2
0.7995132
x1 <--> x1
0.6634154
x2 <--> x2
0.8516653
x3 <--> x3
0.8324362
x4 <--> x4
0.8490373
x5 <--> x5
0.6642423
x6 <--> x6
0.6604066
x7 <--> x7
0.8450092
x8 <--> x8
0.8110486
x9 <--> x9
0.8413409 x10 <--> x10
0.7601531 x11 <--> x11
0.7644141 x12 <--> x12
0.6849291
f3 <--> f3
0.6013587
f4 <--> f4
1.0000000
f1 <--> f1
1.0000000
f2 <--> f2
0.2044343
f2 <--> f1

.80

.66

.85

.66

.85

.81

X1

X2

X3

X7

X8

X9

e1

# specifyModel を使う方法
smd.1 <- specifyModel()x1 <- f1, NA, 1x2 <- f1, b2, NA
x3 <- f1, b3, NA
x4 <- f2, NA, 1
x5 <- f2, b5, NA
x6 <- f2, b6, NA
x7 <- f3, NA, 1
x8 <- f3, b8, NA
x9 <- f3, b9, NA
x10 <- f4, NA, 1
x11 <- f4, b11, NA
x12 <- f4, b12, NA
f3 <- f1, a31, NA
f4 <- f1, a41, NA
f4 <- f2, a42, NA
x1 <-> x1, ev1, NA
x2 <-> x2, ev2, NA
x3 <-> x3, ev3, NA
x4 <-> x4, ev4, NA
x5 <-> x5, ev5, NA
x6 <-> x6, ev6, NA
x7 <-> x7, ev7, NA
x8 <-> x8, ev8, NA
x9 <-> x9, ev9, NA
x10 <-> x10, ev10, NA
x11 <-> x11, ev11, NA
x12 <-> x12, ev12, NA
f3 <-> f3, vf3, NA
f4 <-> f4, vf4, NA
f1 <-> f1, vf1, NA
f2 <-> f2, vf2, NA
f1 <-> f2, cf12, NA

.45

e2

e3

e7

.58 .39

.58
.56

f1

e8

e9

.39 .43

f3

d3 .68f4

d4 .60

.30

.20

.50

f2
.41

.39 .58

X4

X5

X6

X 10

e5

e6

e 10

e4

.83

.85

.40

.66

.84

.49 .49

X 11

e 11

.76

X 12

e 12

.76

X2=83.03, df =50, p=0.002,
AGFI=0.93, RMSEA=0.05,CFI=0.84

sem.smd.1 <- sem(smd.1, cor.d1, N=nrow(d1))
summary(sem.smd.1)
stdCoef(sem.smd.1)

348

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

潜在変数の構造方程式モデリング ― lavaanパッケージ
パッケージの読み込み
library(lavaan)
あらかじめlavaanパッケージをインストールしておく必要がある．
モデルの設定モデル名 <- '# 測定変数の指定（=~ を使う）
潜在変数名1 =~ 観測変数1 + 観測変数2 + …
潜在変数名2 =~ 観測変数1 + 観測変数2 + …
# 回帰式（~ を使う）
従属変数名1 ~ 説明変数1 + 説明変数2 + …
従属変数名2 ~ 説明変数1 + 説明変数2 + …
# 分散，共分散（~~ を使う）
変数名i ~~ 変数名i
# 分散
変数名j ~~ 変数名k
# 共分散'
モデル部分はシングルカンマ（'）でくくる．
すべての変数の分散を推定する場合は分散の指定は省略できる．
パラメタ値の推定
lavaanオブジェクト名 <- sem(モデル名, data=データ名)

またはlavaanオブジェクト名 <- lavaan(モデル名, data=データ名, model.type="sem",auto.var=TRUE,auto.fix.first=TRUE, auto.cov.lv.x=FALSE, auto.cov.y=FALSE)
auto.var=TRUE： すべての変数の分散または残差分散を推定する
auto.fix.first=TRUE： 非標準化解において測定変数のうち最初の１つのパス係数を１に固定する
auto.cov.lv.x=FALSE： 潜在変数間の共分散を自動的には推定しない
auto.cov.y=FALSE： 従属変数の残差間の共分散を自動的には推定しない
summary(lavaanオブジェクト名, fit.measures=TRUE, standardized=TRUE)

モデル部分のスクリプトの例
model.1 <- '# latent variable definitions
f1 =~ x1 + x2 + x3
f2 =~ x4 + x5 + x6
f3 =~ x7 + x8 + x9
f4 =~ x10 + x11 + x12# regression
f3 ~ f1
f4 ~ f1 + f2
# variances and covariances
f1 ~~ f2'
# すべての分散を推定するので，分散の式は省略している349

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("共分散構造分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12
1 4 3 2 3 4 4 2 4 2443
2 2 3 2 5 3 4 5 3 3444
3 1 4 2 2 3 3 4 3 2344
4 1 5 2 2 3 2 3 2 2543
5 2 3 1 4 2 1 3 3 2111
6 2 4 3 3 5 4 4 3 42
41>> #データフレームの行数（標本の大きさ），平均，標準偏差，共分散，相関> n.d1 <- nrow(d1)> mean.d1 <- apply(d1, 2, mean)> sd.d1 <- apply(d1, 2, sd)> cor.d1 <- cor(d1)> round(data.frame(n.d1, mean.d1, sd.d1, cor.d1),2)
n.d1 mean.d1 sd.d1
x1
x2
x3
x4
x5
x6
x7
x8
x9
276
3.01 0.98 1.00 0.28 0.19 0.27 -0.01 0.03 0.11 0.07 0.08
276
3.01 1.03 0.28 1.00 0.22 -0.01 0.02 0.04 0.28 0.06 0.09
276
3.00 0.99 0.19 0.22 1.00 -0.01 0.03 0.01 0.12 0.08 0.09
276
2.99 1.02 0.27 -0.01 -0.01 1.00 0.20 0.23 0.03 0.04 0.02
276
3.00 1.00 -0.01 0.02 0.03 0.20 1.00 0.21 0.05 0.23 0.02
276
3.03 1.04 0.03 0.04 0.01 0.23 0.21 1.00 0.09 0.04 0.07
276
3.03 0.99 0.11 0.28 0.12 0.03 0.05 0.09 1.00 0.21 0.23
276
3.01 1.01 0.07 0.06 0.08 0.04 0.23 0.04 0.21 1.00 0.24
276
3.00 1.01 0.08 0.09 0.09 0.02 0.02 0.07 0.23 0.24 1.00
276
2.99 1.03 0.06 0.08 0.21 0.09 0.08 0.09 0.06 0.09 0.06
276
2.99 1.00 0.07 0.09 0.01 0.08 0.08 0.29 0.05 0.03 0.04
276
2.99 1.01 0.07 0.10 0.07 0.08 0.10 0.11 0.07 0.11 0.22x10 x11 x12x1 0.06 0.07 0.07
x2 0.08 0.09 0.10
x3 0.21 0.01 0.07
x4 0.09 0.08 0.08
x5 0.08 0.08 0.10
x6 0.09 0.29 0.11
x7 0.06 0.05 0.07
x8 0.09 0.03 0.11
x9 0.06 0.04 0.22
x10 1.00 0.17 0.22
x11 0.17 1.00 0.24
x12 0.22 0.24 1.00
>
>
x1
x2
x3
x4
x5
x6
x7
x8
x9
x10
x11
x12

> #共分散構造分析の実行> #lavaanパッケージの読み込み> library(lavaan)>> # モデルの設定> model.1 <- '+ # latent variable definitions+
f1 =~ x1 + x2 + x3+
f2 =~ x4 + x5 + x6+
f3 =~ x7 + x8 + x9+
f4 =~ x10 + x11 + x12++ # regression+
f3 ~ f1+
f4 ~ f1 + f2+
+ # variances and covariances+
f1 ~~ f2
+ '
>

350

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # lavaan関数を使って計算> lav.model.1 <- lavaan(model.1, data=d1, model.type="sem",+
fixed.x=F, meanstructure=F,+
auto.var=TRUE,auto.fix.first=TRUE)> summary(lav.model.1, fit.measures=TRUE, standardized=TRUE)
lavaan 0.6-12 ended normally after 58 iterations
Estimator
Optimization method
Number of model parametersML
NLMINB
28

Number of observations

276

Model Test User Model:
Test statistic
Degrees of freedom
P-value (Chi-square)

83.32850
0.002

Model Test Baseline Model:
Test statistic
Degrees of freedom
P-value276.59366
0.000

User Model versus Baseline Model:
Comparative Fit Index (CFI)
Tucker-Lewis Index (TLI)

0.842
0.791

Loglikelihood and Information Criteria:
Loglikelihood user model (H0)
Loglikelihood unrestricted model (H1)-4630.239-4588.575

Akaike (AIC)
Bayesian (BIC)
Sample-size adjusted Bayesian (BIC)

9316.478
9417.849
9329.066

Root Mean Square Error of Approximation:
RMSEA
90 Percent confidence interval - lower
90 Percent confidence interval - upper
P-value RMSEA <= 0.05

0.049
0.030
0.067
0.508

Standardized Root Mean Square Residual:
SRMR

0.054

Parameter Estimates:
Standard errors
Information
Information saturated (h1) modelStandard
Expected
Structured

Latent Variables:
f1 =~
x1
x2
x3
f2 =~
x4
x5
x6
f3 =~
x7
x8

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

1.000
1.367
0.873

0.359
0.248

3.809
3.523

0.000
0.000

0.438
0.599
0.382

0.448
0.580
0.385

1.000
0.931
1.442

0.287
0.440

3.243
3.277

0.001
0.001

0.418
0.389
0.603

0.409
0.389
0.579

1.000
0.691

0.202

3.421

0.001

0.576
0.398

0.583
0.394

351

名古屋 大学
x9
f4 =~
x10
x11
x12

大 学院 教育発 達科 学研 究科・ 教育 学部

0.763

0.217

3.522

0.000

0.439

0.435

1.000
1.193
1.195

0.343
0.344

3.474
3.470

0.001
0.001

0.408
0.487
0.488

0.398
0.490
0.485

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.739

0.224

3.298

0.001

0.561

0.561

0.280
0.486

0.141
0.191

1.988
2.543

0.047
0.011

0.300
0.498

0.300
0.498

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.037

0.025

1.525

0.127

0.204

0.204

Estimate
0.765
0.707
0.839
0.868
0.852
0.719
0.645
0.863
0.829
0.884
0.752
0.773
0.192
0.175
0.227
0.100

Std.Err
0.084
0.108
0.084
0.094
0.089
0.124
0.107
0.089
0.091
0.092
0.093
0.094
0.072
0.076
0.093
0.050

z-value
9.100
6.528
9.953
9.281
9.597
5.794
6.032
9.684
9.066
9.622
8.126
8.210
2.655
2.313
2.435
1.997

P(>|z|)
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.008
0.021
0.015
0.046

Std.lv
0.765
0.707
0.839
0.868
0.852
0.719
0.645
0.863
0.829
0.884
0.752
0.773
1.000
1.000
0.685
0.601

Std.all
0.800
0.663
0.852
0.832
0.849
0.664
0.660
0.845
0.811
0.841
0.760
0.764
1.000
1.000
0.685
0.601

Regressions:
f3 ~
f1
f4 ~
f1
f2
Covariances:f1 ~~f2
Variances:
.x1
.x2
.x3
.x4
.x5
.x6
.x7
.x8
.x9
.x10
.x11
.x12
f1
f2
.f3
.f4

352

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

成長曲線モデル ― lavaanパッケージ
パッケージの読み込み
library(lavaan)
あらかじめlavaanパッケージをインストールしておく必要がある．
モデルの設定モデル名 <- '# 測定変数の指定（=~ を使う）
切片潜在変数名 =~ 1*観測変数1 + 1*観測変数2 + 1*観測変数3 + …
傾き潜在変数名 =~ 0*観測変数1 + 1*観測変数2 + 2*観測変数3 + …
# 回帰式（~ を使う）
切片潜在変数名 ~ 説明変数1 + 説明変数2 + …
傾き潜在変数名 ~ 説明変数1 + 説明変数2 + …
観測変数名1 ~ 説明変数1 + 説明変数2 + …
# 分散，共分散（~~ を使う）
変数名i ~~ 変数名i
# 分散
変数名j ~~ 変数名k
# 共分散'
モデル部分はシングルカンマ（'）でくくる．
すべての変数の分散を推定する場合は分散の指定は省略できる．
パラメタ値の推定
lavaanオブジェクト名 <- growth(モデル名, data=データ名)

またはlavaanオブジェクト名 <- lavaan(モデル名, data=データ名, model.type="growth",
fixed.x=F, int.lv.free=TRUE, auto.var=TRUE)
fixed.x=FALSE： 外生変数となる観測変数の分散，共分散，平均を標本平均で固定する
int.lv.free = TRUE ： 潜在変数の切片を推定する
auto.var=TRUE： すべての変数の分散または残差分散を推定する
summary(lavaanオブジェクト名, fit.measures=TRUE)
結果の解釈には非標準化解を用いるので standardized=TRUE はつけていない．
切片変数と傾き変数の相関を求めるために標準化解を求めることはある．

モデル部分のスクリプトの例
model.1 <- '# latent variable definitions
f.inter =~ 1*t1 + 1*t2 + 1*t3 + 1*t4
f.slope =~ 0*t1 + 1*t2 + 2*t3 + 3*t4
# regression# variances and covariances
f.inter ~~ f.slope'# すべての分散を推定するので，分散の式は省略している

t1

t2

1

1

t3

t4

1
0

1

1
2

3

誤差は省略

切片

353

傾き

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("成長曲線モデル_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id t1 t2 t3 t4
1 1 3 6 8 12
2 2 8 12 17 22
3 3 8 11 13 16
4 4 7 13 20 25
5 5 7 13 20 25
6 6 7 14 20 26>> # id 列の削除
> d1 <- d1[,c(-1)]>> #データフレームの行数（標本の大きさ），平均，標準偏差，共分散，相関> n.d1 <- nrow(d1)> mean.d1 <- apply(d1, 2, mean)> sd.d1 <- apply(d1, 2, sd)> cor.d1 <- cor(d1)> round(data.frame(n.d1, mean.d1, sd.d1, cor.d1),2)
n.d1 mean.d1 sd.d1
t1
t2
t3
t4
t1
60
5.62 1.53 1.00 0.74 0.57 0.50
t260
10.10 2.20 0.74 1.00 0.93 0.91
t360
14.73 3.44 0.57 0.93 1.00 0.98
t460
19.15 4.68 0.50 0.91 0.98 1.00
> #lavaanパッケージの読み込み> library(lavaan)>> # モデルの設定> model.1 <- '+ # latent variable definitions+
f.inter =~ 1*t1 + 1*t2 + 1*t3 + 1*t4+
f.slope =~ 0*t1 + 1*t2 + 2*t3 + 3*t4+
+ # regression++ # variances and covariances+
f.inter ~~ f.slope+ '> # growth関数を使って計算> gro.model.1 <- growth(model.1, data=d1)>> summary(gro.model.1, fit.measures=TRUE)
lavaan 0.6-12 ended normally after 43 iterations
Estimator
Optimization method
Number of model parametersML
NLMINB
9

Number of observations

60

Model Test User Model:
Test statistic
Degrees of freedom
P-value (Chi-square)

2.609
5
0.760

Model Test Baseline Model:
Test statistic
Degrees of freedom
P-value

390.102
6
0.000

User Model versus Baseline Model:
354

名古屋 大学
Comparative Fit Index (CFI)
Tucker-Lewis Index (TLI)

大 学院 教育発 達科 学研 究科・ 教育 学部

1.000
1.007

Loglikelihood and Information Criteria:
Loglikelihood user model (H0)
Loglikelihood unrestricted model (H1)-384.343-383.039

Akaike (AIC)
Bayesian (BIC)
Sample-size adjusted Bayesian (BIC)

786.687805.536777.228

Root Mean Square Error of Approximation:
RMSEA
90 Percent confidence interval - lower
90 Percent confidence interval - upper
P-value RMSEA <= 0.05

0.000
0.000
0.124
0.813

Standardized Root Mean Square Residual:
SRMR

0.017

Parameter Estimates:
Standard errors
Information
Information saturated (h1) model
Latent Variables:
f.inter =~
t1
t2
t3
t4
f.slope =~
t1
t2
t3
t4

Estimate

Standard
Expected
Structured

Std.Errz-value

P(>|z|)

Estimate

Std.Errz-value

P(>|z|)

0.482

0.261

1.843

0.065

Estimate
0.000
0.000
0.000
0.000
5.610
4.515

Std.Errz-value

P(>|z|)

0.185
0.177

30.26825.470

0.000
0.000

Estimate
0.355
0.164
0.360
0.044
1.886
1.858

Std.Err
0.141
0.060
0.096
0.187
0.378
0.346

z-value
2.512
2.707
3.743
0.236
4.992
5.374

P(>|z|)
0.012
0.007
0.000
0.813
0.000
0.000

1.000
1.000
1.000
1.000
0.000
1.000
2.000
3.000

Covariances:f.inter ~~f.slopeIntercepts:
.t1
.t2
.t3
.t4
f.interf.slope
Variances:
.t1
.t2
.t3
.t4
f.interf.slope# lavaan関数を使って計算．同一の結果
lav.model.1 <- lavaan(model.1, data=d1, model.type="growth",
fixed.x=F, int.lv.free=TRUE, auto.var=TRUE)
summary(lav.model.1, fit.measures=TRUE)
355

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多母集団分析 ― semパッケージ
library(sem)opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI","SRMR", "AIC", "AICc", "BIC", "CAIC"))
モデル名1 <- specifyEquations()
構造方程式
モデル名2 <- specifyEquations()
構造方程式…
群分け変数名 <- factor(群分け変数名)
mgオブジェクト名 <- multigroupModel(モデル名1, モデル名2, …, groups=levels(群分け変数名))
semオブジェクト名 <- sem(mgオブジェクト名, data=データ行列, group="群分け変数")
summary(semオブジェクト名)
stdCoef(semオブジェクト名)
群分け変数名に「group」を用いると不具合が生じることがあるので他の名前を使う
群分け変数のfactor化で，levels=c(水準1,水準2,…), labels=c(ラベル1,ラベル2,…) を設定してもよい
各群のモデルで，同じパラメタ名にすると等値制約になる
群分け変数名はfactor関数を使ってfactor化しておかなければならない
等値制約を加える場合は，例えば，b12.1 と b12.2 をともに b12というパラメタ名にすると，両群に共通な b12 というパラメタ値を推定する
あらかじめsemパッケージをインストールしておく必要がある．
適合度指標は，デフォルトではAICくらいしか出力されない．必要なものを出力するように指定する．
パス係数の頭文字は b にしておくのが無難．他の文字を用いると，それだけで不具合になる場合がある．
空白行があるところで，モデルの設定が修了したとみなされる．
（逆に，行をあけないと，モデル設定が終了したことにならない）

モデル部分のスクリプトの例
seq.1 <- specifyEquations()
x1 = 1*f1
x2 = b2.1*f1
x3 = b3.1*f1
x4 = 1*f2
x5 = b5.1*f2
x6 = b6.1*f2
x7 = 1*f3
x8 = b8.1*f3
x9 = b9.1*f3
x10 = 1*f4
x11 = b11.1*f4
x12 = b12.1*f4
f3 = a31.1*f1
f4 = a41.1*f1 + a42.1*f2
V(x1) = ev1.1
V(x2) = ev2.1
V(x3) = ev3.1
V(x4) = ev4.1
V(x5) = ev5.1
V(x6) = ev6.1
V(x7) = ev7.1
V(x8) = ev8.1
V(x9) = ev9.1
V(x10) = ev10.1
V(x11) = ev11.1
V(x12) = ev12.1
V(f3) = evf3.1
V(f4) = evf4.1
V(f1) = vf1.1
V(f2) = vf2.1
C(f1, f2) = cf12.1

356

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

seq.2 <- specifyEquations()
x1 = 1*f1
x2 = b2.2*f1
x3 = b3.2*f1
x4 = 1*f2
x5 = b5.2*f2
x6 = b6.2*f2
x7 = 1*f3
x8 = b8.2*f3
x9 = b9.2*f3
x10 = 1*f4
x11 = b11.2*f4
x12 = b12.2*f4
f3 = a31.2*f1
f4 = a41.2*f1 + a42.2*f2
V(x1) = ev1.2
V(x2) = ev2.2
V(x3) = ev3.2
V(x4) = ev4.2
V(x5) = ev5.2
V(x6) = ev6.2
V(x7) = ev7.2
V(x8) = ev8.2
V(x9) = ev9.2
V(x10) = ev10.2
V(x11) = ev11.2
V(x12) = ev12.2
V(f3) = evf3.2
V(f4) = evf4.2
V(f1) = vf1.2
V(f2) = vf2.2
C(f1, f2) = cf12.2> setwd("d:\\")> d1 <- read.table("多母集団分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 era
1 1 4 3 2 3 4 4 2 4 2443 20102 2 2 3 2 5 3 4 5 3 3444 20103 3 1 4 2 2 3 3 4 3 2
34
4 20004 4 1 5 2 2 3 2 3 2 2
54
3 20005 5 2 3 1 4 2 1 3 3 211
1 20006 6 2 4 3 3 5 4 4 3 424
1 2010>> # id 列の削除
> d1 <- d1[,c(-1)]>> #データフレームの行数（標本サイズ），平均，標準偏差，共分散，相関> n.d1 <- nrow(d1)> mean.d1 <- apply(d1, 2, mean)> sd.d1 <- apply(d1, 2, sd)> cov.d1 <- cov(d1)> cor.d1 <- cor(d1)> round(data.frame(n.d1, mean.d1, sd.d1, cov.d1, cor.d1),2)
x1
x2
x3
x4
x5
x6
x7
x8
x9
x10

n.d1 mean.d1 sd.d1
x1
x2
x3
x4
x5
x6
x7
x8
x9
276
3.01 0.98 0.96 0.28 0.19 0.27 -0.01 0.03 0.11 0.07 0.08
276
3.01 1.03 0.28 1.07 0.22 -0.01 0.03 0.04 0.28 0.06 0.09
276
3.00 0.99 0.19 0.22 0.99 -0.01 0.03 0.01 0.12 0.08 0.09
276
2.99 1.02 0.27 -0.01 -0.01 1.05 0.20 0.24 0.03 0.04 0.02
276
3.00 1.00 -0.01 0.03 0.03 0.20 1.01 0.22 0.05 0.23 0.02
276
3.03 1.04 0.03 0.04 0.01 0.24 0.22 1.09 0.09 0.05 0.07
276
3.03 0.99 0.11 0.28 0.12 0.03 0.05 0.09 0.98 0.21 0.23
276
3.01 1.01 0.07 0.06 0.08 0.04 0.23 0.05 0.21 1.03 0.24
276
3.00 1.01 0.08 0.09 0.09 0.02 0.02 0.07 0.23 0.24 1.03
276
2.99 1.03 0.06 0.08 0.21 0.09 0.08 0.09 0.07 0.09 0.06
357

x10
0.06
0.08
0.21
0.09
0.08
0.09
0.07
0.09
0.06
1.05

x11 x120.07 0.07
0.09 0.11
0.01 0.07
0.08 0.09
0.08 0.11
0.30 0.12
0.05 0.07
0.03 0.11
0.04 0.22
0.17 0.23

名古屋 大学
x11
x12
era

276
2.99
276
2.99
276 2004.93

1.00 0.07
1.01 0.07
5.01 -0.04

0.09
0.11
0.11

0.01 0.08
0.07 0.09
0.22 -0.26

大 学院 教育発 達科 学研 究科・ 教育 学部

0.08 0.30 0.05 0.03 0.04 0.17 0.99 0.24
0.11 0.12 0.07 0.11 0.22 0.23 0.24 1.01
0.45 0.13 0.26 0.36 0.11 -0.29 -0.09 0.13

era x1.1 x2.1 x3.1 x4.1 x5.1 x6.1 x7.1 x8.1 x9.1 x10.1 x11.1 x12.1 era.1
x1 -0.04 1.00 0.28 0.19 0.27 -0.01 0.03 0.11 0.07 0.08 0.06 0.07 0.07 -0.01
x2
0.11 0.28 1.00 0.22 -0.01 0.02 0.04 0.28 0.06 0.09 0.08 0.09 0.10 0.02
x3
0.22 0.19 0.22 1.00 -0.01 0.03 0.01 0.12 0.08 0.09 0.21 0.01 0.07 0.04
x4 -0.26 0.27 -0.01 -0.01 1.00 0.20 0.23 0.03 0.04 0.02 0.09 0.08 0.08 -0.05
x50.45 -0.01 0.02 0.03 0.20 1.00 0.21 0.05 0.23 0.02 0.08 0.08 0.10 0.09
x6
0.13 0.03 0.04 0.01 0.23 0.21 1.00 0.09 0.04 0.07 0.09 0.29 0.11 0.02
x7
0.26 0.11 0.28 0.12 0.03 0.05 0.09 1.00 0.21 0.23 0.06 0.05 0.07 0.05
x8
0.36 0.07 0.06 0.08 0.04 0.23 0.04 0.21 1.00 0.24 0.09 0.03 0.11 0.07
x9
0.11 0.08 0.09 0.09 0.02 0.02 0.07 0.23 0.24 1.00 0.06 0.04 0.22 0.02
x10 -0.29 0.06 0.08 0.21 0.09 0.08 0.09 0.06 0.09 0.06 1.00 0.17 0.22 -0.06
x11 -0.09 0.07 0.09 0.01 0.08 0.08 0.29 0.05 0.03 0.04 0.17 1.00 0.24 -0.02
x12 0.13 0.07 0.10 0.07 0.08 0.10 0.11 0.07 0.11 0.22 0.22 0.24 1.00 0.03
era 25.09 -0.01 0.02 0.04 -0.05 0.09 0.02 0.05 0.07 0.02 -0.06 -0.02 0.03 1.00>>
> # 適合度指標の設定> library(sem)> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI",+"SRMR", "AIC", "AICc", "BIC", "CAIC"))>> # 多母集団分析モデル> # specifyEquations を使う方法> seq.1 <- specifyEquations()
1: x1 = 1*f1
2: x2 = b2.1*f1
3: x3 = b3.1*f1
4: x4 = 1*f2
5: x5 = b5.1*f2
6: x6 = b6.1*f2
7: x7 = 1*f3
8: x8 = b8.1*f3
9: x9 = b9.1*f3
10: x10 = 1*f4
11: x11 = b11.1*f4
12: x12 = b12.1*f4
13: f3 = a31.1*f1
14: f4 = a41.1*f1 + a42.1*f2
15: V(x1) = ev1.1
16: V(x2) = ev2.1
17: V(x3) = ev3.1
18: V(x4) = ev4.1
19: V(x5) = ev5.1
20: V(x6) = ev6.1
21: V(x7) = ev7.1
22: V(x8) = ev8.1
23: V(x9) = ev9.1
24: V(x10) = ev10.1
25: V(x11) = ev11.1
26: V(x12) = ev12.1
27: V(f3) = evf3.1
28: V(f4) = evf4.1
29: V(f1) = vf1.1
30: V(f2) = vf2.1
31: C(f1, f2) = cf12.1
32:
Read 31 items> seq.2 <- specifyEquations()
1: x1 = 1*f1
2: x2 = b2.2*f1
3: x3 = b3.2*f1
4: x4 = 1*f2
5: x5 = b5.2*f2
358

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

6: x6 = b6.2*f2
7: x7 = 1*f3
8: x8 = b8.2*f3
9: x9 = b9.2*f3
10: x10 = 1*f4
11: x11 = b11.2*f4
12: x12 = b12.2*f4
13: f3 = a31.2*f1
14: f4 = a41.2*f1 + a42.2*f2
15: V(x1) = ev1.2
16: V(x2) = ev2.2
17: V(x3) = ev3.2
18: V(x4) = ev4.2
19: V(x5) = ev5.2
20: V(x6) = ev6.2
21: V(x7) = ev7.2
22: V(x8) = ev8.2
23: V(x9) = ev9.2
24: V(x10) = ev10.2
25: V(x11) = ev11.2
26: V(x12) = ev12.2
27: V(f3) = evf3.2
28: V(f4) = evf4.2
29: V(f1) = vf1.2
30: V(f2) = vf2.2
31: C(f1, f2) = cf12.2
32:
Read 31 items>> d1$era <- factor(d1$era)> mg.smd <- multigroupModel(smd.1, smd.2, groups=levels(d1$era))> sem.mg.seq <- sem(mg.seq, data=d1, group="era")> summary(sem.mg.seq)
Model Chisquare = 139.27 Df = 100 Pr(>Chisq) = 0.0057848
Chisquare (null model) = 351.43 Df = 132
Goodness-of-fit index = 0.92389
Adjusted goodness-of-fit index = 0.8904
RMSEA index = 0.053541 90% CI: (0.029782, 0.07371)
Bentler-Bonnett NFI = 0.6037
Tucker-Lewis NNFI = 0.76375
Bentler CFI = 0.82102
SRMR = 0.07014
AIC = 251.27
AICc = 168.42
BIC = 454.02
Iterations: initial fits, 55 57

final fit, 0era: 2000
Model Chisquare = 55.626
Df = 50 Pr(>Chisq) = 0.27128
Chisquare (null model) = 201.42
Df = 66
Goodness-of-fit index = 0.93966
Adjusted goodness-of-fit index = 0.90587
RMSEA index = 0.028452
90% CI: (NA, 0.06355)
Bentler-Bonnett NFI = 0.72383
Tucker-Lewis NNFI = 0.94516
Bentler CFI = 0.95845
SRMR = 0.059422
AIC = 111.63
AICc = 70.257
BIC = 193.99
CAIC = -241.46
Normalized Residuals
Min. 1st Qu.
Median-1.58000 -0.34000 0.00361

Mean
0.04690

3rd Qu.
0.52400

Max.
2.49000

R-square for Endogenous Variables359

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

x1
x2
x3
x4
x5
x6
f3
x7
x8
x9
f4
x10
x11
0.2201 0.3168 0.2498 0.1351 0.2667 0.4718 0.3518 0.3523 0.2093 0.2718 0.4097 0.1134 0.3386
x12
0.3100Parameter Estimates
Estimate Std Error z value Pr(>|z|)b2.1
1.387211 0.431740 3.2131 1.3132e-03 x2 <--- f1
b3.1
1.108615 0.354829 3.1244 1.7819e-03 x3 <--- f1
b5.1
1.419028 0.498984 2.8438 4.4574e-03 x5 <--- f2
b6.1
1.901602 0.689501 2.7579 5.8167e-03 x6 <--- f2
b8.1
0.840790 0.270683 3.1062 1.8952e-03 x8 <--- f3
b9.1
0.976374 0.302761 3.2249 1.2602e-03 x9 <--- f3
b11.1 1.641288 0.628409 2.6118 9.0063e-03 x11 <--- f4
b12.1 1.536786 0.589578 2.6066 9.1450e-03 x12 <--- f4
a31.1 0.715202 0.264344 2.7056 6.8187e-03 f3 <--- f1
a41.1 0.275824 0.165362 1.6680 9.5315e-02 f4 <--- f1
a42.1 0.433487 0.236005 1.8368 6.6244e-02 f4 <--- f2
ev1.1 0.734696 0.110091 6.6735 2.4974e-11 x1 <--> x1
ev2.1 0.860047 0.153842 5.5905 2.2647e-08 x2 <--> x2
ev3.1 0.764970 0.120229 6.3626 1.9838e-10 x3 <--> x3
ev4.1 0.901075 0.120738 7.4631 8.4519e-14 x4 <--> x4
ev5.1 0.779726 0.129340 6.0285 1.6547e-09 x5 <--> x5
ev6.1 0.569972 0.167696 3.3988 6.7674e-04 x6 <--> x6
ev7.1 0.554234 0.111914 4.9523 7.3333e-07 x7 <--> x7
ev8.1 0.805212 0.120075 6.7059 2.0014e-11 x8 <--> x8
ev9.1 0.769747 0.128642 5.9837 2.1819e-09 x9 <--> x9
ev10.1 1.024657 0.135168 7.5806 3.4385e-14 x10 <--> x10
ev11.1 0.689958 0.134091 5.1454 2.6690e-07 x11 <--> x11
ev12.1 0.689099 0.124773 5.5228 3.3363e-08 x12 <--> x12
evf3.1 0.195389 0.094658 2.0642 3.9003e-02 f3 <--> f3
evf4.1 0.077390 0.054608 1.4172 1.5643e-01 f4 <--> f4
vf1.1 0.207288 0.096718 2.1432 3.2095e-02 f1 <--> f1
vf2.1 0.140805 0.082652 1.7036 8.8458e-02 f2 <--> f2
cf12.1 0.048003 0.030753 1.5609 1.1854e-01 f2 <--> f1
era: 2010
Model Chisquare = 83.647
Df = 50 Pr(>Chisq) = 0.0020042
Chisquare (null model) = 150.02
Df = 66
Goodness-of-fit index = 0.90766
Adjusted goodness-of-fit index = 0.85595
RMSEA index = 0.070603
90% CI: (0.042712, 0.096505)
Bentler-Bonnett NFI = 0.44242
Tucker-Lewis NNFI = 0.47137
Bentler CFI = 0.59952
SRMR = 0.081173
AIC = 139.65
AICc = 98.825
BIC = 221.2
CAIC = -211.99
Normalized Residuals
Min. 1st Qu. Median-2.4200 -0.6220 -0.0153

Mean 3rd Qu.
0.0057 0.3470

Max.
2.9700R-square for Endogenous Variables
x1
x2
x3
x4
x5
x6
f3
x7
x8
x9
f4
x10
x11
0.1830 0.2500 0.1217 0.8147 0.0245 0.0576 0.3041 0.3805 0.0861 0.0885 0.2979 0.5350 0.0562
x12
0.1042
Parameter Estimates
Estimate Std Error z value Pr(>|z|)b2.2
1.104586 0.444171 2.48685 1.2888e-02 x2 <--- f1
b3.2
0.805446 0.366318 2.19876 2.7895e-02 x3 <--- f1
b5.2
0.163661 0.210236 0.77847 4.3629e-01 x5 <--- f2
b6.2
0.271632 0.328033 0.82806 4.0763e-01 x6 <--- f2
b8.2
0.457730 0.275959 1.65869 9.7179e-02 x8 <--- f3
b9.2
0.457250 0.274247 1.66729 9.5456e-02 x9 <--- f3
b11.2 0.323457 0.201419 1.60589 1.0830e-01 x11 <--- f4
b12.2 0.460724 0.251944 1.82867 6.7448e-02 x12 <--- f4
360

名古屋 大学
a31.2 0.844737 0.388132
a41.2 0.837488 0.388973
a42.2 0.105691 0.163408
ev1.2 0.804811 0.125131
ev2.2 0.660110 0.118741
ev3.2 0.844021 0.118422
ev4.2 0.195468 0.999339
ev5.2 0.917287 0.115124
ev6.2 1.037627 0.146550
ev7.2 0.688786 0.251684
ev8.2 0.940539 0.129059
ev9.2 0.911040 0.125573
ev10.2 0.442294 0.263279
ev11.2 0.894038 0.114490
ev12.2 0.928807 0.127870
evf3.2 0.294469 0.235574
evf4.2 0.357242 0.261303
vf1.2 0.180320 0.104133
vf2.2 0.859379 1.006991
cf12.2 0.087748 0.060126

2.17642 2.9524e-02 f3 <--- f1
2.15307 3.1313e-02 f4 <--- f1
0.64679 5.1777e-01 f4 <--- f2
6.43173 1.2616e-10 x1 <--> x1
5.55924 2.7095e-08 x2 <--> x2
7.12723 1.0241e-12 x3 <--> x3
0.19560 8.4493e-01 x4 <--> x4
7.96778 1.6155e-15 x5 <--> x5
7.08038 1.4376e-12 x6 <--> x6
2.73671 6.2056e-03 x7 <--> x7
7.28768 3.1533e-13 x8 <--> x8
7.25508 4.0144e-13 x9 <--> x9
1.67994 9.2968e-02 x10 <--> x10
7.80888 5.7697e-15 x11 <--> x11
7.26367 3.7673e-13 x12 <--> x12
1.25001 2.1130e-01 f3 <--> f3
1.36716 1.7158e-01 f4 <--> f4
1.73163 8.3339e-02 f1 <--> f1
0.85341 3.9343e-01 f2 <--> f2
1.45939 1.4446e-01 f2 <--> f1> stdCoef(sem.mg.seq)
Group:

2000
Std. Estimate
10.4690996
x1 <--- f1
2
b2.1
0.5628938
x2 <--- f1
3
b3.1
0.4998324
x3 <--- f1
4
0.3676214
x4 <--- f2
5b5.1
0.5163943
x5 <--- f2
6
b6.1
0.6868962
x6 <--- f2
7
0.5935218
x7 <--- f3
8b8.1
0.4574426
x8 <--- f3
9b9.1
0.5213693
x9 <--- f3
10
0.3367948 x10 <--- f4
11 b11.1
0.5818584 x11 <--- f4
12 b12.1
0.5567894 x12 <--- f4
13 a31.1
0.5931025
f3 <--- f1
14 a41.1
0.3468331
f4 <--- f1
15 a42.1
0.4492499
f4 <--- f2
16 ev1.1
0.7799455
x1 <--> x1
17 ev2.1
0.6831505
x2 <--> x2
18 ev3.1
0.7501675
x3 <--> x3
19 ev4.1
0.8648545
x4 <--> x4
20 ev5.1
0.7333369
x5 <--> x5
21 ev6.1
0.5281736
x6 <--> x6
22 ev7.1
0.6477319
x7 <--> x7
23 ev8.1
0.7907463
x8 <--> x8
24 ev9.1
0.7281741
x9 <--> x9
25 ev10.1
0.8865693 x10 <--> x10
26 ev11.1
0.6614408 x11 <--> x11
27 ev12.1
0.6899855 x12 <--> x12
28 evf3.1
0.6482294
f3 <--> f3
29 evf4.1
0.5903208
f4 <--> f4
30 vf1.1
1.0000000
f1 <--> f1
31 vf2.1
1.0000000
f2 <--> f2
32 cf12.1
0.2809765
f2 <--> f1
Group:
1
2
3
4
5
6
7
8
9
10

2010
Std. Estimate
0.4278336
b2.2
0.4999775
b3.2
0.3488959
0.9026048
b5.2
0.1564604
b6.2
0.2399789
0.6168856
b8.2
0.2934971
b9.2
0.2975113
0.7314283

x1 <--- f1
x2 <--- f1
x3 <--- f1
x4 <--- f2
x5 <--- f2
x6 <--- f2
x7 <--- f3
x8 <--- f3
x9 <--- f3
x10 <--- f4361

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学
11 b11.2
12 b12.2
13 a31.2
14 a41.2
15 a42.2
16 ev1.2
17 ev2.2
18 ev3.2
19 ev4.2
20 ev5.2
21 ev6.2
22 ev7.2
23 ev8.2
24 ev9.2
25 ev10.2
26 ev11.2
27 ev12.2
28 evf3.2
29 evf4.2
30 vf1.2
31 vf2.2
32 cf12.2>

0.2370683 x11 <--- f4
0.3227633 x12 <--- f4
0.5514428
f3 <--- f1
0.4985463
f4 <--- f1
0.1373522
f4 <--- f2
0.8169584
x1 <--> x1
0.7500225
x2 <--> x2
0.8782716
x3 <--> x3
0.1853045
x4 <--> x4
0.9755201
x5 <--> x5
0.9424101
x6 <--> x6
0.6194522
x7 <--> x7
0.9138594
x8 <--> x8
0.9114870
x9 <--> x9
0.4650126 x10 <--> x10
0.9437986 x11 <--> x11
0.8958239 x12 <--> x12
0.6959108
f3 <--> f3
0.7020583
f4 <--> f4
1.0000000
f1 <--> f1
1.0000000
f2 <--> f2
0.2229062
f2 <--> f1

362

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多母集団分析 ― lavaanパッケージ
パッケージの読み込み
library(lavaan)
あらかじめlavaanパッケージをインストールしておく必要がある．
lavaanパッケージをインストールするために，mnormtパッケージをインストールしておく．
モデルの設定モデル名 <- '# 測定変数の指定（=~ を使う）
潜在変数名1 =~ 観測変数1 + 観測変数2 + …
潜在変数名2 =~ 観測変数1 + 観測変数2 + …
# 回帰式（~ を使う）
従属変数名1 ~ 説明変数1 + 説明変数2 + …
従属変数名2 ~ 説明変数1 + 説明変数2 + …
# 分散，共分散（~~ を使う）
変数名i ~~ 変数名i
# 分散
変数名j ~~ 変数名k
# 共分散'
モデル部分はシングルカンマ（'）でくくる．
すべての変数の分散を推定する場合は分散の指定は省略できる．
パラメタ値の推定
lavaanオブジェクト名 <- lavaan(モデル名, data=データ名, model.type="sem", group="群分け変数名",
fixed.x=FALSE, meanstructure=FALSE, auto.var=TRUE, auto.fix.first=TRUE)
group="群分け変数名"： 母集団を分ける変数の名前を指定する
fixed.x=FALSE： 外生変数となる観測変数の分散，共分散，平均を標本平均で固定する
meanstructure=False ： 平均構造の検討をしない
auto.var=TRUE： すべての変数の分散または残差分散を推定する
auto.fix.first=TRUE ： 非標準化解において測定変数のうち最初の１つのパス係数を１に固定する
summary(lavaanオブジェクト名, fit.measures=TRUE, standardized=TRUE)

モデル部分のスクリプトの例
model.1 <- '# latent variable definitions
f1 =~ x1 + x2 + x3
f2 =~ x4 + x5 + x6
f3 =~ x7 + x8 + x9
f4 =~ x10 + x11 + x12# regression
f3 ~ f1
f4 ~ f1 + f2
# variances and covariances
f1 ~~ f2'
# すべての分散を推定するので，分散の式は省略している

363

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("多母集団分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> # id 列の削除
> d1 <- d1[,c(-1)]>> #データフレームの行数（標本の大きさ），平均，標準偏差，共分散，相関> n.d1 <- nrow(d1)> mean.d1 <- apply(d1, 2, mean)> sd.d1 <- apply(d1, 2, sd)> cov.d1 <- cov(d1)> cor.d1 <- cor(d1)> round(data.frame(n.d1, mean.d1, sd.d1, cov.d1, cor.d1),2)>> # 群ごとのデータフレーム作成と記述統計量> ds1 <- d1[d1$era==2000,]> n.ds1 <- nrow(ds1)> mean.ds1 <- apply(ds1, 2, mean)> sd.ds1 <- apply(ds1, 2, sd)> cov.ds1 <- cov(ds1)> cor.ds1 <- cor(ds1)>> ds2 <- d1[d1$era==2010,]> n.ds2 <- nrow(ds2)> mean.ds2 <- apply(ds2, 2, mean)> sd.ds2 <- apply(ds2, 2, sd)> cov.ds2 <- cov(ds2)> cor.ds2 <- cor(ds2)>>#lavaanパッケージの読み込み
library(lavaan)> # モデルの設定> model.1 <- '+ # latent variable definitions+
f1 =~ x1 + x2 + x3+
f2 =~ x4 + x5 + x6+
f3 =~ x7 + x8 + x9+
f4 =~ x10 + x11 + x12++ # regression+
f3 ~ f1+
f4 ~ f1 + f2+
+ # variances and covariances+
f1 ~~ f2
+ '>> # lavaan関数を使って計算> fit.model.1 <- lavaan(model.1, data=d1, model.type="sem", group="era",+
fixed.x=F, meanstructure=F,+
auto.var=TRUE,auto.fix.first=TRUE)> summary(fit.model.1, fit.measures=TRUE, standardized=TRUE)
lavaan 0.6-12 ended normally after 146 iterations
Estimator
Optimization method
Number of model parametersML
NLMINB
56

Number of observations per group:
2010
2000

136
140

Model Test User Model:
Test statistic
Degrees of freedom

140.293100
364

名古屋 大学
P-value (Chi-square)
Test statistic for each group:
2010
2000

大 学院 教育発 達科 学研 究科・ 教育 学部

0.005
84.26756.026

Model Test Baseline Model:
Test statistic
Degrees of freedom
P-value

353.995
132
0.000

User Model versus Baseline Model:
Comparative Fit Index (CFI)
Tucker-Lewis Index (TLI)

0.818
0.760

Loglikelihood and Information Criteria:
Loglikelihood user model (H0)
Loglikelihood unrestricted model (H1)-4611.761-4541.615

Akaike (AIC)
Bayesian (BIC)
Sample-size adjusted Bayesian (BIC)

9335.523
9538.265
9360.699

Root Mean Square Error of Approximation:
RMSEA
90 Percent confidence interval - lower
90 Percent confidence interval - upper
P-value RMSEA <= 0.05

0.054
0.031
0.074
0.362

Standardized Root Mean Square Residual:
SRMR

0.070

Parameter Estimates:
Standard errors
Information
Information saturated (h1) modelStandard
Expected
Structured

Group 1 [2010]:
Latent Variables:
f1 =~
x1
x2
x3
f2 =~
x4
x5
x6
f3 =~
x7
x8
x9
f4 =~
x10
x11
x12
Regressions:
f3 ~
f1
f4 ~
f1
f2

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

1.000
1.105
0.805

0.443
0.365

2.496
2.207

0.013
0.027

0.423
0.467
0.341

0.428
0.500
0.349

1.000
0.164
0.272

0.209
0.327

0.781
0.831

0.435
0.406

0.924
0.151
0.251

0.903
0.156
0.240

1.000
0.458
0.457

0.275
0.273

1.665
1.673

0.096
0.094

0.648
0.297
0.296

0.617
0.293
0.298

1.000
0.323
0.461

0.201
0.251

1.612
1.835

0.107
0.066

0.711
0.230
0.327

0.731
0.237
0.323

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.845

0.387

2.184

0.029

0.551

0.551

0.837
0.106

0.388
0.163

2.161
0.649

0.031
0.516

0.499
0.137

0.499
0.137

365

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Covariances:f1 ~~f2
Variances:
.x1
.x2
.x3
.x4
.x5
.x6
.x7
.x8
.x9
.x10
.x11
.x12
f1
f2
.f3
.f4

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.087

0.059

1.465

0.143

0.223

0.223

Estimate
0.799
0.655
0.838
0.194
0.911
1.030
0.684
0.934
0.904
0.439
0.887
0.922
0.179
0.853
0.292
0.355

Std.Err
0.124
0.117
0.117
0.988
0.114
0.145
0.249
0.128
0.124
0.260
0.113
0.126
0.103
0.996
0.233
0.258

z-value
6.455
5.580
7.154
0.196
7.997
7.107
2.747
7.315
7.282
1.686
7.838
7.291
1.738
0.857
1.255
1.372

P(>|z|)
0.000
0.000
0.000
0.844
0.000
0.000
0.006
0.000
0.000
0.092
0.000
0.000
0.082
0.392
0.210
0.170

Std.lv
0.799
0.655
0.838
0.194
0.911
1.030
0.684
0.934
0.904
0.439
0.887
0.922
1.000
1.000
0.696
0.702

Std.all
0.817
0.750
0.878
0.185
0.976
0.942
0.619
0.914
0.911
0.465
0.944
0.896
1.000
1.000
0.696
0.702

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

1.000
1.387
1.109

0.430
0.354

3.225
3.136

0.001
0.002

0.454
0.629
0.503

0.469
0.563
0.500

1.000
1.419
1.902

0.497
0.687

2.854
2.768

0.004
0.006

0.374
0.531
0.711

0.368
0.516
0.687

1.000
0.841
0.976

0.270
0.302

3.117
3.236

0.002
0.001

0.547
0.460
0.534

0.594
0.457
0.521

1.000
1.641
1.537

0.626
0.587

2.621
2.616

0.009
0.009

0.361
0.592
0.554

0.337
0.582
0.557

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.715

0.263

2.715

0.007

0.593

0.593

0.276
0.433

0.165
0.235

1.674
1.843

0.094
0.065

0.347
0.449

0.347
0.449

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.048

0.030

1.566

0.117

0.281

0.281

Estimate
0.729
0.854
0.760
0.895
0.774
0.566
0.550
0.799
0.764
1.017
0.685

Std.Err
0.109
0.152
0.119
0.119
0.128
0.166
0.111
0.119
0.127
0.134
0.133

z-value
6.698
5.610
6.386
7.490
6.050
3.411
4.970
6.730
6.005
7.608
5.164

P(>|z|)
0.000
0.000
0.000
0.000
0.000
0.001
0.000
0.000
0.000
0.000
0.000

Std.lv
0.729
0.854
0.760
0.895
0.774
0.566
0.550
0.799
0.764
1.017
0.685

Std.all
0.780
0.683
0.750
0.865
0.733
0.528
0.648
0.791
0.728
0.887
0.661

Group 2 [2000]:
Latent Variables:
f1 =~
x1
x2
x3
f2 =~
x4
x5
x6
f3 =~
x7
x8
x9
f4 =~
x10
x11
x12
Regressions:
f3 ~
f1
f4 ~
f1
f2
Covariances:f1 ~~f2
Variances:
.x1
.x2
.x3
.x4
.x5
.x6
.x7
.x8
.x9
.x10
.x11

366

名古屋 大学
.x12
f1
f2
.f3
.f4

0.684
0.206
0.140
0.194
0.077

0.123
0.096
0.082
0.094
0.054

5.543
2.151
1.710
2.072
1.422

0.000
0.031
0.087
0.038
0.155

367

大 学院 教育発 達科 学研 究科・ 教育 学部
0.684
1.000
1.000
0.648
0.590

0.690
1.000
1.000
0.648
0.590

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

等値制約 ― semパッケージ
seq.1 <- specifyEquations()
x1 = 1*f1
x2 = b2.1*f1
x3 = b3.1*f1
x4 = 1*f2
x5 = b5.1*f2
x6 = b6.1*f2
x7 = 1*f3
x8 = b8.1*f3
x9 = b9.1*f3
x10 = 1*f4
x11 = b11.1*f4
x12 = b12*f4#b12の値は２つの母集団で共通
f3 = a31.1*f1
f4 = a41.1*f1 + a42.1*f2
V(x1) = ev1.1
V(x2) = ev2.1
V(x3) = ev3.1
V(x4) = ev4.1
V(x5) = ev5.1
V(x6) = ev6.1
V(x7) = ev7.1
V(x8) = ev8.1
V(x9) = ev9.1
V(x10) = ev10.1
V(x11) = ev11.1
V(x12) = ev12.1
V(f3) = evf3.1
V(f4) = evf4.1
V(f1) = vf1#f1の分散の値は２つの母集団で共通
V(f2) = vf2.1
C(f1, f2) = cf12.1
seq.2 <- specifyEquations()
x1 = 1*f1
x2 = b2.2*f1
x3 = b3.2*f1
x4 = 1*f2
x5 = b5.2*f2
x6 = b6.2*f2
x7 = 1*f3
x8 = b8.2*f3
x9 = b9.2*f3
x10 = 1*f4
x11 = b11.2*f4
x12 = b12*f4#b12の値は２つの母集団で共通
f3 = a31.2*f1
f4 = a41.2*f1 + a42.2*f2
V(x1) = ev1.2
V(x2) = ev2.2
V(x3) = ev3.2
V(x4) = ev4.2
V(x5) = ev5.2
V(x6) = ev6.2
V(x7) = ev7.2
V(x8) = ev8.2
V(x9) = ev9.2
V(x10) = ev10.2
V(x11) = ev11.2
V(x12) = ev12.2
V(f3) = evf3.2
V(f4) = evf4.2
V(f1) = vf1#f1の分散の値は２つの母集団で共通
V(f2) = vf2.2
C(f1, f2) = cf12.2
sem パッケージでは，多母集団分析において，母集団間の等値制約はおけるが同一母集団内で等値制約はおけない（多母集団分析でなければ，単一母集団内で等値制約はおける）
368

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("多母集団分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 era
1 1 4 3 2 3 4 4 2 4 2443 20102 2 2 3 2 5 3 4 5 3 3444 20103 3 1 4 2 2 3 3 4 3 2
34
4 20004 4 1 5 2 2 3 2 3 2 2
54
3 20005 5 2 3 1 4 2 1 3 3 211
1 20006 6 2 4 3 3 5 4 4 3 424
1 2010>> # id 列の削除
> d1 <- d1[,c(-1)]>>> #データフレームの行数（標本サイズ），平均，標準偏差，共分散，相関> n.d1 <- nrow(d1)> mean.d1 <- apply(d1, 2, mean)> sd.d1 <- apply(d1, 2, sd)> cov.d1 <- cov(d1)> cor.d1 <- cor(d1)> round(data.frame(n.d1, mean.d1, sd.d1, cov.d1, cor.d1),2)
x1
x2
x3
x4
x5
x6
x7
x8
x9
x10
x11
x12
era

n.d1 mean.d1 sd.d1
x1
x2
x3
x4
x5
x6
x7
x8
x9
x10
x11 x12276
3.01 0.98 0.96 0.28 0.19 0.27 -0.01 0.03 0.11 0.07 0.08 0.06 0.07 0.07
276
3.01 1.03 0.28 1.07 0.22 -0.01 0.03 0.04 0.28 0.06 0.09 0.08 0.09 0.11
276
3.00 0.99 0.19 0.22 0.99 -0.01 0.03 0.01 0.12 0.08 0.09 0.21 0.01 0.07
276
2.99 1.02 0.27 -0.01 -0.01 1.05 0.20 0.24 0.03 0.04 0.02 0.09 0.08 0.09
276
3.00 1.00 -0.01 0.03 0.03 0.20 1.01 0.22 0.05 0.23 0.02 0.08 0.08 0.11
276
3.03 1.04 0.03 0.04 0.01 0.24 0.22 1.09 0.09 0.05 0.07 0.09 0.30 0.12
276
3.03 0.99 0.11 0.28 0.12 0.03 0.05 0.09 0.98 0.21 0.23 0.07 0.05 0.07
276
3.01 1.01 0.07 0.06 0.08 0.04 0.23 0.05 0.21 1.03 0.24 0.09 0.03 0.11
276
3.00 1.01 0.08 0.09 0.09 0.02 0.02 0.07 0.23 0.24 1.03 0.06 0.04 0.22276
2.99 1.03 0.06 0.08 0.21 0.09 0.08 0.09 0.07 0.09 0.06 1.05 0.17 0.23
276
2.99 1.00 0.07 0.09 0.01 0.08 0.08 0.30 0.05 0.03 0.04 0.17 0.99 0.24
276
2.99 1.01 0.07 0.11 0.07 0.09 0.11 0.12 0.07 0.11 0.22 0.23 0.24 1.01
276 2004.93 5.01 -0.04 0.11 0.22 -0.26 0.45 0.13 0.26 0.36 0.11 -0.29 -0.09 0.13

era x1.1 x2.1 x3.1 x4.1 x5.1 x6.1 x7.1 x8.1 x9.1 x10.1 x11.1 x12.1 era.1
x1 -0.04 1.00 0.28 0.19 0.27 -0.01 0.03 0.11 0.07 0.08 0.06 0.07 0.07 -0.01
x2
0.11 0.28 1.00 0.22 -0.01 0.02 0.04 0.28 0.06 0.09 0.08 0.09 0.10 0.02
x3
0.22 0.19 0.22 1.00 -0.01 0.03 0.01 0.12 0.08 0.09 0.21 0.01 0.07 0.04
x4 -0.26 0.27 -0.01 -0.01 1.00 0.20 0.23 0.03 0.04 0.02 0.09 0.08 0.08 -0.05
x50.45 -0.01 0.02 0.03 0.20 1.00 0.21 0.05 0.23 0.02 0.08 0.08 0.10 0.09
x6
0.13 0.03 0.04 0.01 0.23 0.21 1.00 0.09 0.04 0.07 0.09 0.29 0.11 0.02
x7
0.26 0.11 0.28 0.12 0.03 0.05 0.09 1.00 0.21 0.23 0.06 0.05 0.07 0.05
x8
0.36 0.07 0.06 0.08 0.04 0.23 0.04 0.21 1.00 0.24 0.09 0.03 0.11 0.07
x9
0.11 0.08 0.09 0.09 0.02 0.02 0.07 0.23 0.24 1.00 0.06 0.04 0.22 0.02
x10 -0.29 0.06 0.08 0.21 0.09 0.08 0.09 0.06 0.09 0.06 1.00 0.17 0.22 -0.06
x11 -0.09 0.07 0.09 0.01 0.08 0.08 0.29 0.05 0.03 0.04 0.17 1.00 0.24 -0.02
x12 0.13 0.07 0.10 0.07 0.08 0.10 0.11 0.07 0.11 0.22 0.22 0.24 1.00 0.03
era 25.09 -0.01 0.02 0.04 -0.05 0.09 0.02 0.05 0.07 0.02 -0.06 -0.02 0.03 1.00>>>>
> #semパッケージの読み込み> library(sem)> opt <- options(fit.indices = c("GFI", "AGFI", "RMSEA", "NFI", "NNFI", "CFI", "RNI", "IFI",+"SRMR", "AIC", "AICc", "BIC", "CAIC"))> # モデルの設定> # specifyEquations を使う方法> seq.1 <- specifyEquations()
1: x1 = 1*f1
2: x2 = b2.1*f1
3: x3 = b3.1*f1
4: x4 = 1*f2
5: x5 = b5.1*f2
6: x6 = b6.1*f2
369

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

7: x7 = 1*f3
8: x8 = b8.1*f3
9: x9 = b9.1*f3
10: x10 = 1*f4
11: x11 = b11.1*f4
12: x12 = b12*f4# b12は共通
13: f3 = a31.1*f1
14: f4 = a41.1*f1 + a42.1*f2
15: V(x1) = ev1.1
16: V(x2) = ev2.1
17: V(x3) = ev3.1
18: V(x4) = ev4.1
19: V(x5) = ev5.1
20: V(x6) = ev6.1
21: V(x7) = ev7.1
22: V(x8) = ev8.1
23: V(x9) = ev9.1
24: V(x10) = ev10.1
25: V(x11) = ev11.1
26: V(x12) = ev12.1
27: V(f3) = evf3.1
28: V(f4) = evf4.1
29: V(f1) = vf1# vf1は共通
30: V(f2) = vf2.1
31: C(f1, f2) = cf12.1
32:
Read 31 items> seq.2 <- specifyEquations()
1: x1 = 1*f1
2: x2 = b2.2*f1
3: x3 = b3.2*f1
4: x4 = 1*f2
5: x5 = b5.2*f2
6: x6 = b6.2*f2
7: x7 = 1*f3
8: x8 = b8.2*f3
9: x9 = b9.2*f3
10: x10 = 1*f4
11: x11 = b11.2*f4
12: x12 = b12*f4
13: f3 = a31.2*f1
14: f4 = a41.2*f1 + a42.2*f2
15: V(x1) = ev1.2
16: V(x2) = ev2.2
17: V(x3) = ev3.2
18: V(x4) = ev4.2
19: V(x5) = ev5.2
20: V(x6) = ev6.2
21: V(x7) = ev7.2
22: V(x8) = ev8.2
23: V(x9) = ev9.2
24: V(x10) = ev10.2
25: V(x11) = ev11.2
26: V(x12) = ev12.2
27: V(f3) = evf3.2
28: V(f4) = evf4.2
29: V(f1) = vf1
30: V(f2) = vf2.2
31: C(f1, f2) = cf12.2
32:
Read 31 items># b12は共通# vf1は共通> d1$era <- factor(d1$era)> mg.smd <- multigroupModel(smd.1, smd.2, groups=levels(d1$era))> sem.mg.seq <- sem(mg.seq, data=d1, group="era")> summary(sem.mg.seq)
Model Chisquare = 142.1825

Df = 102

Pr(>Chisq) = 0.005291511
370

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Chisquare (null model) = 351.4344 Df = 132
Goodness-of-fit index = 0.923128
Adjusted goodness-of-fit index = 0.8914749
RMSEA index = 0.05362383 90% CI: (0.03018218, 0.07358887)
Bentler-Bonett NFI = 0.5954225
Tucker-Lewis NNFI = 0.7630234
Bentler CFI = 0.8168817
Bentler RNI = 0.8168817
Bollen IFI = 0.8389057
SRMR = 0.07158386
AIC = 250.1825
AICc = 169.0603
BIC = -431.0984
Iterations: initial fits, 55 60

final fit, 139era: 2000
Model Chisquare = 56.45178
Df = 50 Pr(>Chisq) = 0.2465492
Goodness-of-fit index = 0.9391849
Adjusted goodness-of-fit index = 0.9051285
RMSEA index = 0.03046825
90% CI: (NA, 0.06473732)
Bentler-Bonett NFI = 0.7197265
Tucker-Lewis NNFI = 0.93711
Bentler CFI = 0.9523561
Bentler RNI = 0.9523561
Bollen IFI = 0.9573905
SRMR = 0.06075693
AIC = 112.4518
AICc = 71.08242
BIC = -190.6303
CAIC = -240.6303
Normalized Residuals
Min. 1st Qu.
Median-1.56083 -0.25398 0.02940

Mean
0.05207

R-square for Endogenous Variables
x1
x2
x3
x4
x5

3rd Qu.
0.43291x6

Max.
2.50861
f3

x7

x8

x9

f4

x10

x11

x12

0.2035 0.3143 0.2536 0.1291 0.2539 0.4952 0.3492 0.3526 0.2094 0.2704 0.4270 0.1615 0.3376 0.2497
Parameter Estimates
Estimate
Std Error z value Pr(>|z|)b2.1
1.44281177 0.38926081 3.706543 2.101079e-04 x2 <--- f1
b3.1
1.16664530 0.32821629 3.554502 3.786963e-04 x3 <--- f1
b5.1
1.41635442 0.50340099 2.813571 4.899457e-03 x5 <--- f2
b6.1
1.99275202 0.73428175 2.713879 6.650040e-03 x6 <--- f2
b8.1
0.84069210 0.27159117 3.095432 1.965262e-03 x8 <--- f3
b9.1
0.97336255 0.30332029 3.209026 1.331857e-03 x9 <--- f3
b11.1 1.35187355 0.40102623 3.371035 7.488628e-04 x11 <--- f4
b12
1.12205994 0.20653943 5.432667 5.551798e-08 x12 <--- f4
a31.1 0.74499427 0.25274994 2.947555 3.202981e-03 f3 <--- f1
a41.1 0.35272750 0.18436477 1.913205 5.572188e-02 f4 <--- f1
a42.1 0.55411081 0.26372698 2.101077 3.563417e-02 f4 <--- f2
ev1.1 0.74276258 0.10499522 7.074251 1.502578e-12 x1 <--> x1
ev2.1 0.86175104 0.15439532 5.581458 2.385101e-08 x2 <--> x2
ev3.1 0.76004083 0.12095401 6.283718 3.305707e-10 x3 <--> x3
ev4.1 0.90727147 0.12057573 7.524495 5.292456e-14 x4 <--> x4
ev5.1 0.79322332 0.12803738 6.195248 5.819332e-10 x5 <--> x5
ev6.1 0.54459531 0.17377645 3.133884 1.725088e-03 x6 <--> x6
ev7.1 0.55355130 0.11227618 4.930265 8.211829e-07 x7 <--> x7
ev8.1 0.80477965 0.12019513 6.695609 2.147749e-11 x8 <--> x8
ev9.1 0.77086937 0.12874386 5.987621 2.129330e-09 x9 <--> x9
ev10.1 1.00017156 0.13531666 7.391341 1.453552e-13 x10 <--> x10
ev11.1 0.69061094 0.13451646 5.134026 2.836094e-07 x11 <--> x11
ev12.1 0.72869908 0.11188128 6.513146 7.359298e-11 x12 <--> x12
evf3.1 0.19620436 0.09525853 2.059704 3.942687e-02 f3 <--> f3
evf4.1 0.11037855 0.05673097 1.945649 5.169693e-02 f4 <--> f4
vf1
0.18972488 0.06652922 2.851753 4.347889e-03 f1 <--> f1
371

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

vf2.1 0.13455050 0.08042451 1.673004 9.432659e-02 f2 <--> f2
cf12.1 0.04434851 0.02792561 1.588095 1.122650e-01 f2 <--> f1
era: 2010
Model Chisquare = 85.73067
Df = 50 Pr(>Chisq) = 0.001242832
Goodness-of-fit index = 0.9065989
Adjusted goodness-of-fit index = 0.8542942
RMSEA index = 0.07275598
90% CI: (0.04545513, 0.09841906)
Bentler-Bonett NFI = 0.4285295
Tucker-Lewis NNFI = 0.438636
Bentler CFI = 0.5747243
Bentler RNI = 0.5747243
Bollen IFI = 0.6427564
SRMR = 0.08272922
AIC = 141.7307
AICc = 100.9082
BIC = -159.9021
CAIC = -209.9021
Normalized Residuals
Min.
1st Qu.
MedianMean-2.433016 -0.621893 -0.072683 -0.007113
R-square for Endogenous Variables
x1
x2
x3
x4
x5

3rd Qu.
0.332538
x6

f3

Max.
2.836605
x7

x8

x9

f4

x10

x11

x12

0.1906 0.3249 0.0736 0.4507 0.0404 0.1081 0.3338 0.4514 0.0669 0.0745 0.3129 0.2209 0.0980 0.2405
Parameter Estimates
Estimate
Std Error z value
Pr(>|z|)b2.2
1.22882736 0.44681848 2.7501713 5.956412e-03 x2 <--- f1
b3.2
0.61084721 0.10857287 5.6261494 1.842768e-08 x3 <--- f1
b5.2
0.28253734 0.49889024 0.5663317 5.711683e-01 x5 <--- f2
b6.2
0.50039605 0.31958163 1.5657848 1.173990e-01 x6 <--- f2
b8.2
0.37012869 0.23522290 1.5735232 1.155977e-01 x8 <--- f3
b9.2
0.38504562 0.36194886 1.0638122 2.874138e-01 x9 <--- f3
b11.2 0.67450823 0.22922686 2.9425357 3.255362e-03 x11 <--- f4
b12
1.12205994 0.20653943 5.4326669 5.551798e-08 x12 <--- f4
a31.2 0.94016351 0.31814536 2.9551382 3.125290e-03 f3 <--- f1
a41.2 0.38605522 0.39713333 0.9721048 3.309984e-01 f4 <--- f1
a42.2 0.22414503 0.24955984 0.8981615 3.690995e-01 f4 <--- f2
ev1.2 0.80592002 0.19924005 4.0449700 5.232982e-05 x1 <--> x1
ev2.2 0.59530461 0.12785409 4.6561250 3.222163e-06 x2 <--> x2
ev3.2 0.89062250 0.13437664 6.6278074 3.407095e-11 x3 <--> x3
ev4.2 0.57953099 0.11708934 4.9494769 7.441322e-07 x4 <--> x4
ev5.2 0.90236193 0.34394060 2.6235982 8.700636e-03 x5 <--> x5
ev6.2 0.98201767 0.11552221 8.5006825 1.884792e-17 x6 <--> x6
ev7.2 0.61049579 0.14855990 4.1094253 3.966450e-05 x7 <--> x7
ev8.2 0.96050019 0.27682076 3.4697549 5.209335e-04 x8 <--> x8
ev9.2 0.92516749 0.12630031 7.3251404 2.386487e-13 x9 <--> x9
ev10.2 0.71972704 0.12176773 5.9106548 3.407504e-09 x10 <--> x10
ev11.2 0.85456365 0.11967505 7.1407002 9.285670e-13 x11 <--> x11
ev12.2 0.81140946 0.11845010 6.8502216 7.373568e-12 x12 <--> x12
evf3.2 0.33471136 0.15612118 2.1439203 3.203928e-02 f3 <--> f3
evf4.2 0.14018911 0.26910582 0.5209442 6.024057e-01 f4 <--> f4
vf1
0.18972488 0.06652922 2.8517528 4.347889e-03 f1 <--> f1
vf2.2 0.47545662 0.35331673 1.3456952 1.784008e-01 f2 <--> f2
cf12.2 0.06742791 0.05589901 1.2062451 2.277230e-01 f2 <--> f1> stdCoef(sem.mg.seq)
Group:
1
2
3
4
5

2000
Std. Estimate
0.4510666
b2.1
0.5606032
b3.1
0.5035817
0.3593734
b5.1
0.5038711

x1 <--- f1
x2 <--- f1
x3 <--- f1
x4 <--- f2
x5 <--- f2
372

名古屋 大学
6
b6.1
7
8
b8.1
9
b9.1
10
11 b11.1
12b12
13 a31.1
14 a41.1
15 a42.1
16 ev1.1
17 ev2.1
18 ev3.1
19 ev4.1
20 ev5.1
21 ev6.1
22 ev7.1
23 ev8.1
24 ev9.1
25 ev10.1
26 ev11.1
27 ev12.1
28 evf3.1
29 evf4.1
30vf1
31 vf2.1
32 cf12.1

0.7037276
x6 <--- f2
0.5938131
x7 <--- f3
0.4575488
x8 <--- f3
0.5199742
x9 <--- f3
0.4018642 x10 <--- f4
0.5810708 x11 <--- f4
0.4997119 x12 <--- f4
0.5909734
f3 <--- f1
0.3500562
f4 <--- f1
0.4631008
f4 <--- f2
0.7965389
x1 <--> x1
0.6857240
x2 <--> x2
0.7464055
x3 <--> x3
0.8708508
x4 <--> x4
0.7461139
x5 <--> x5
0.5047674
x6 <--> x6
0.6473860
x7 <--> x7
0.7906491
x8 <--> x8
0.7296269
x9 <--> x9
0.8385052 x10 <--> x10
0.6623567 x11 <--> x110.7502880 x12 <--> x120.6507504
f3 <--> f3
0.5730035
f4 <--> f4
1.0000000
f1 <--> f1
1.0000000
f2 <--> f2
0.2775711
f2 <--> f1

Group:

2010
Std. Estimate
10.4365258
x1 <--- f12
b2.2
0.5699934
x2 <--- f1
3
b3.2
0.2713559
x3 <--- f1
4
0.6713234
x4 <--- f2
5b5.2
0.2009066x5 <--- f2
6b6.2
0.3288227
x6 <--- f2
7
0.6718929
x7 <--- f3
8b8.2
0.2585861
x8 <--- f3
9b9.2
0.2729710
x9 <--- f3
10
0.4699609 x10 <--- f4
11 b11.2
0.3130131 x11 <--- f4
12b12
0.4903575 x12 <--- f4
13 a31.2
0.5777449
f3 <--- f1
14 a41.2
0.3722827
f4 <--- f1
15 a42.2
0.3421730
f4 <--- f2
16 ev1.2
0.8094452
x1 <--> x1
17 ev2.2
0.6751075
x2 <--> x2
18 ev3.2
0.9263660
x3 <--> x3
19 ev4.2
0.5493249
x4 <--> x4
20 ev5.2
0.9596365
x5 <--> x5
21 ev6.2
0.8918756
x6 <--> x6
22 ev7.2
0.5485599
x7 <--> x7
23 ev8.2
0.9331332
x8 <--> x8
24 ev9.2
0.9254868
x9 <--> x9
25 ev10.2
0.7791368 x10 <--> x10
26 ev11.2
0.9020228 x11 <--> x11
27 ev12.2
0.7595495 x12 <--> x12
28 evf3.2
0.6662108
f3 <--> f3
29 evf4.2
0.6871266
f4 <--> f430
vf1
1.0000000
f1 <--> f1
31 vf2.2
1.0000000
f2 <--> f2
32 cf12.2
0.2245030
f2 <--> f1>

373

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

等値制約 ― lavaanパッケージ
lavaanパッケージを使う方法の例（２群の多母集団分析）
model.1 <- '# latent variable definitions
f1 =~ x1 + c("b12","")*x2 + c("b131","b132")*x3
f2 =~ x4 + equal(c("b12",""))*x5 + c(NA,0)*x6
f3 =~ x7 + x8 + equal(c("b131","b132"))*x9
f4 =~ x10 + x11 + c("b412","b412")*x12# regression
f3 ~ f1
f4 ~ f1 + f2
# variances and covariances
f1 ~~ c("vf1","vf1")*f1
f1 ~~ f2'b12
： 第１群において，x2 <- f1 と x5 <- f2 は同じ値
b131 ： 第１群において，x3 <- f1 と x9 <- f3 は同じ値
b132 ： 第２群において，x3 <- f1 と x9 <- f3 は同じ値
b412 ： 第１群と第２群の x12 <- f4 は同じ値
c(NA,0)：x6<-f2 のパス係数を，第１群は推定するが，第２群は0に固定
vf1： 第１群と第２群のf1の分散は同じ値
equal()を使うように説明されているが，c()に同じ系数名を書くだけでも同じ値で推定されるようだ．
semパッケージを使うときも，係数に同じ名前をつければ，等値制約となる．

> setwd("d:\\")> d1 <- read.table("多母集団分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> # id 列の削除
> d1 <- d1[,c(-1)]> #データフレームの行数（標本の大きさ），平均，標準偏差，共分散，相関> n.d1 <- nrow(d1)> mean.d1 <- apply(d1, 2, mean)> sd.d1 <- apply(d1, 2, sd)> cov.d1 <- cov(d1)> cor.d1 <- cor(d1)> round(data.frame(n.d1, mean.d1, sd.d1, cov.d1, cor.d1),2)>> # 群ごとのデータフレーム作成と記述統計量> ds1 <- d1[d1$era==2000,]> n.ds1 <- nrow(ds1)> mean.ds1 <- apply(ds1, 2, mean)> sd.ds1 <- apply(ds1, 2, sd)> cov.ds1 <- cov(ds1)> cor.ds1 <- cor(ds1)>> ds2 <- d1[d1$era==2010,]> n.ds2 <- nrow(ds2)> mean.ds2 <- apply(ds2, 2, mean)> sd.ds2 <- apply(ds2, 2, sd)> cov.ds2 <- cov(ds2)> cor.ds2 <- cor(ds2)374名古屋 大学>>>

大 学院 教育発 達科 学研 究科・ 教育 学部#lavaanパッケージの読み込み
library(lavaan)> model.1 <- '+ # latent variable definitions+
f1 =~ x1 + c("b12","")*x2 + c("b131","b132")*x3+
f2 =~ x4 + equal(c("b12",""))*x5 + c(NA,0)*x6+
f3 =~ x7 + x8 + equal(c("b131","b132"))*x9+
f4 =~ x10 + x11 + c("b412","b412")*x12++ # regression+
f3 ~ f1+
f4 ~ f1 + f2+
+ # variances and covariancess+f1 ~~ c("vf1","vf1")*f1+
f1 ~~ f2
+ '>> # lavaan関数を使って計算> lav.model.1 <- lavaan(model.1, data=d1, model.type="sem", group="era",+
fixed.x=F, meanstructure=F,+
auto.var=TRUE,auto.fix.first=TRUE)> summary(lav.model.1, fit.measures=TRUE, standardized=TRUE)
lavaan 0.6-12 ended normally after 99 iterations
Estimator
Optimization method
Number of model parameters
Number of equality constraints

ML
NLMINB55
5

Number of observations per group:
2010
2000

136
140

Model Test User Model:
Test statistic
Degrees of freedom
P-value (Chi-square)
Test statistic for each group:
2010
2000

175.730106
0.000
90.87484.855Model Test Baseline Model:
Test statistic
Degrees of freedom
P-value

353.995
132
0.000

User Model versus Baseline Model:
Comparative Fit Index (CFI)
Tucker-Lewis Index (TLI)

0.686
0.609

Loglikelihood and Information Criteria:
Loglikelihood user model (H0)
Loglikelihood unrestricted model (H1)-4629.480-4541.615

Akaike (AIC)
Bayesian (BIC)
Sample-size adjusted Bayesian (BIC)

9358.960
9539.980
9381.438

Root Mean Square Error of Approximation:
RMSEA
90 Percent confidence interval - lower

0.069
0.050
375

名古屋 大学
90 Percent confidence interval - upper
P-value RMSEA <= 0.05

大 学院 教育発 達科 学研 究科・ 教育 学部

0.087
0.047

Standardized Root Mean Square Residual:
SRMR

0.087

Parameter Estimates:
Standard errors
Information
Information saturated (h1) modelStandard
Expected
Structured

Group 1 [2010]:
Latent Variables:
f1 =~
x1
x2
x3
f2 =~
x4
x5
x6
f3 =~
x7
x8
x9
f4 =~
x10
x11
x12

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

1.000
0.848
0.552

0.261
0.205

3.253
2.688

0.001
0.007

0.478
0.405
0.264

0.479
0.441
0.270

1.000
0.848
0.935

0.261
0.514

3.253
1.818

0.001
0.069

0.423
0.359
0.396

0.420
0.365
0.378

(b131)

1.000
0.537
0.552

0.283
0.205

1.899
2.688

0.058
0.007

0.600
0.322
0.331

0.571
0.318
0.332

(b412)

1.000
0.734
1.241

0.353
0.355

2.081
3.499

0.037
0.000

0.420
0.308
0.522

0.440
0.318
0.506

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.720

0.286

2.515

0.012

0.574

0.574

0.353
0.386

0.207
0.282

1.705
1.372

0.088
0.170

0.401
0.389

0.401
0.389

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.044

0.046

0.954

0.340

0.217

0.217

Estimate
0.228
0.766
0.681
0.882
0.835
0.838
0.936
0.742
0.918
0.884
0.736
0.845
0.790
0.179
0.241
0.109

Std.Err
0.069
0.120
0.110
0.115
0.139
0.124
0.156
0.188
0.129
0.121
0.115
0.118
0.144
0.105
0.168
0.072

z-value
3.322
6.383
6.181
7.662
6.015
6.771
5.997
3.941
7.099
7.289
6.416
7.181
5.473
1.700
1.438
1.527

P(>|z|)
0.001
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.089
0.150
0.127

Std.lv
1.000
0.766
0.681
0.882
0.835
0.838
0.936
0.742
0.918
0.884
0.736
0.845
0.790
1.000
0.670
0.620

Std.all
1.000
0.770
0.806
0.927
0.823
0.867
0.857
0.674
0.899
0.890
0.807
0.899
0.744
1.000
0.670
0.620

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all(b12)(b131)(b12)

Regressions:
f3 ~
f1
f4 ~
f1
f2
Covariances:f1 ~~f2
Variances:
f1
.x1
.x2
.x3
.x4
.x5
.x6
.x7
.x8
.x9
.x10
.x11
.x12
f2
.f3
.f4

(vf1)

Group 2 [2000]:
Latent Variables:376名古屋 大学
f1 =~
x1
x2
x3
f2 =~
x4
x5
x6
f3 =~
x7
x8
x9
f4 =~
x10
x11
x12

1.000
1.343
1.014

0.478
0.642
0.485

0.490
0.573
0.482

0.331
0.831
0.000

0.325
0.809
0.000

0.001
0.000

0.538
0.461
0.546

0.585
0.458
0.532

2.940
3.499

0.003
0.000

0.448
0.538
0.556

0.411
0.528
0.566

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.682

0.193

3.545

0.000

0.606

0.606

0.378
0.311

0.182
0.230

2.083
1.353

0.037
0.176

0.404
0.229

0.404
0.229

Estimate

Std.Errz-value

P(>|z|)

Std.lv

Std.all

0.036

0.040

0.907

0.364

0.229

0.229

Estimate
0.228
0.725
0.842
0.775
0.925
0.365
1.071
0.558
0.800
0.757
0.987
0.747
0.656
0.109
0.183
0.149

Std.Err
0.069
0.105
0.152
0.114
0.152
0.663
0.128
0.100
0.118
0.120
0.138
0.134
0.126
0.118
0.080
0.078

z-value
3.322
6.916
5.544
6.817
6.076
0.550
8.367
5.582
6.749
6.311
7.130
5.587
5.225
0.923
2.302
1.915

P(>|z|)
0.001
0.000
0.000
0.000
0.000
0.582
0.000
0.000
0.000
0.000
0.000
0.000
0.000
0.356
0.021
0.055

Std.lv
1.000
0.725
0.842
0.775
0.925
0.365
1.071
0.558
0.800
0.757
0.987
0.747
0.656
1.000
0.633
0.742

Std.all
1.000
0.760
0.672
0.767
0.894
0.345
1.000
0.658
0.790
0.717
0.831
0.721
0.679
1.000
0.633
0.742

0.335
0.208

4.009
4.878

0.000
0.000

2.450

1.026

0.305

(b132)

1.000
0.856
1.014

0.255
0.208

3.356
4.878

(b412)

1.000
1.199
1.241

0.408
0.355

Estimate(b132)

1.000
2.514
0.000

Regressions:
f3 ~
f1
f4 ~
f1
f2

大 学院 教育発 達科 学研 究科・ 教育 学部

Covariances:f1 ~~f2
Variances:
f1
.x1
.x2
.x3
.x4
.x5
.x6
.x7
.x8
.x9
.x10
.x11
.x12
f2
.f3
.f4

(vf1)

377

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

クラスター分析
データの標準化（測定単位に意味がなければデータを標準化しておくことがすすめられる）(新)データフレーム名 <- scale(データフレーム名)
特に指定しなければ，平均=0，標準偏差=1に標準化する．
距離行列の作成
距離行列名 <- dist((新)データフレーム名, method="距離定義名")
method="euclidean", "maximum", "manhattan", "canberra", "binary" or "minkowski"

階層的クラスター分析
出力名 <- hclust(距離行列名^2, method="方法名")
method = "ward.D", "centroid" の場合
出力名 <- hclust(距離行列名, method="方法名")
method = "ward.D2", "single", "complete", "average", "mcquitty", "median" の場合
デンドログラムの表示
縦向き
plot(出力名)
横向き
plot(as.dendrogram(出力名), horiz=TRUE)あるクラスタ数におけるクラスタリング状況の出力
cutree(出力名)

非階層的クラスター分析
kmeans(データフレーム名,クラスター数)> setwd("d:\\")> d1 <- read.table("クラスター分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)item p.na b.na p.correct b.correct
1 国01
0.028 0.395
0.462
0.337
2 国07
0.019 0.377
0.944
0.251
3 国08
0.143 0.479
0.509
0.305
4 国09
0.090 0.525
0.767
0.301
5 国13
0.206 0.585
0.717
0.275
6 国14
0.237 0.565
0.846
0.283
>
> # データの標準化> d2 <- d1[,c("p.na","b.na","p.correct","b.correct")]> d2 <- scale(d2)>> # 距離行列の作成> rownames(d2) <-d1$item> dist1 <- dist(d2, method="euclidean")>378

名古屋 大学> # 階層的クラスター分析> hclust1 <- hclust(dist1, method="ward.D2")

大 学院 教育発 達科 学研 究科・ 教育 学部# 平方ユークリッド距離・Ward法> # 縦向きのデンドログラム> plot(hclust1)> # 横向きのデンドログラム> plot(as.dendrogram(hclust1), horiz=TRUE)

379

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #あるクラスター数における分類状況> cutree(hclust1, k=8)
国01
国14
社05

国07
1
3

国15
社06

3
社11

理08
理25

3
3
2

国16

3

社07

数15
理13

5
8
7

3

7
2

数29

5

理14

7

3

380

社10

数30
理18

1
4

5
数09

3

社18

社24

数07

社02

3

5
社23

6

社08

国13
2

社16

5
数04

国17

2
社13

社20
3

国09
3

2

5

数13

2

社12

社19
数02

国08
2

4
社25

5
3
6
3

数11
理06
理22

5
8
8
7

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 非階層的クラスター分析> kmeans1 <- kmeans(d2,8)> kmeans1
K-means clustering with 8 clusters of sizes 8, 2, 11, 5, 5, 4, 4, 2
Cluster means:
p.na
b.na
p.correct
b.correct
1 -0.9359166 -0.4090408 1.10945829 -0.52525861
2 -1.3595650 -3.1765849 -0.27831316 1.75893008
3 0.1795248 0.2579431 0.62075262 0.59585997
4 0.1252978 0.5125858 -1.25963056 0.59123084
5 -0.9640269 -0.6739169 -0.32720618 0.01027442
6 1.1384655 0.8465117 -0.07088825 -0.39940401
7 0.7357503 0.8376307 -0.79934479 -1.53064882
8 2.4642359 0.4291043 -1.86610150 -0.57878298
Clustering vector:
国01
国07
5
国13
国14
3
国17
社02
1
社07
社08
1
社12
社13
7
社19
社20
3
社25
数02
7
数09
数11
1
数29
数30
6
理13
理14
4
理25
3

国08
1
3
5

国09
5

国15

1

社05

5
6
8
3
3
8
4

3

社06

3

社10

1

国16

5

社11

2
社16

6

7

社18

社23
4
数04

1

理22

3

Within cluster sum of squares by cluster:[1] 8.6698755 0.1420172 13.6068424 3.0583587[8] 0.8415862(between_SS / total_SS = 77.6 %)

3
理08

4

理18

1
数15

3
理06

7
数07

6
数13

2
社24

3.6257138

4

1.3138106

4.6073177

Available components:[1] "cluster"[6] "betweenss">"centers""size""totss""iter""withinss""ifault"# 階層的な方法と非階層的な方法で計算方法が異なるので，# 同じクラス多数でも，必ずしも分類状況は一致しない

381"tot.withinss"名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対応分析
データフレーム化したクロス表を用いて，行カテゴリと，列カテゴリの関連性を分析し，図示する。
クロス表のデータフレーム化
テーブル名 <- table(行変数名, 列変数名)
データフレーム名 <- as.data.frame(matrix(テーブル名, 行数, 列数))
rownames(データフレーム名) <- c("行カテゴリ1","行カテゴリ2",…)colnames(データフレーム名) <- c("列カテゴリ1","列カテゴリ2",…)

MASS パッケージを使う方法
library(MASS)
オブジェクト名 <- corresp(データフレーム名, nf=2)
plot(オブジェクト名, las=1)
MASSパッケージは，Rインストール時に，自動的にインストールされてる。
テーブルをデータフレーム化したものを読み込む。

CA パッケージを用いる方法
library(ca)オブジェクト名 <- ca(データフレーム名)
plot(オブジェクト名)
あらかじめ ca パッケージをインストールしておく必要がある。
テーブルをデータフレーム化したものを読み込む。

FactoMineR パッケージを使う方法
library(FactoMineR)
オブジェクト名 <- CA(データフレーム名)
plot(オブジェクト名)
あらかじめ FactoMineR パッケージをインストールしておく必要がある。
テーブルをデータフレーム化したものを読み込む。

> setwd("i:\\Rdocuments\\scripts\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>
# クロス表> (t1 <- table(d1$進路, d1$学科))
就職
進学
不明

医学 看護学 心理学
64
80
75
10
13
15
2
7
4

>

382

名古屋 大学> # データフレーム化したクロス表の作成> t2 <- as.data.frame(matrix(t1,3,3))> rownames(t2) <- c("Work","Study","Unkown")> colnames(t2) <- c("Med","Nur","Psy")> t2
Med Nur Psy
Work
64 80 75Study
10 13 15
Unkown2
7
4>> # 対応分析
> # MASS パッケージを使う方法> library(MASS)>> cr1 <- corresp(t2, nf=2)> cr1
First canonical correlation(s): 0.08388651 0.03824868
Row scores:
[,1]
[,2]
Work
-0.2042625 0.4372111
Study -0.3421564 -2.4470783
Unkown 4.4411877 -0.2123270
Column scores:
[,1]
[,2]
Med -1.1939676 1.0616369
Nur 1.2277632 0.4388595
Psy -0.3407955 -1.3252165>> # プロット表示> plot(cr1, las=1)>>>> # CA パッケージを用いる方法> library(ca)>> cr2 <- ca(t2)> cr2
Principal inertias (eigenvalues):
1
2
Value
0.007037 0.001463
Percentage 82.79%
17.21%
Rows:
Work
Study
UnkownMass
0.811111 0.140741 0.048148
ChiDist 0.023943 0.097900 0.372644
Inertia 0.000465 0.001349 0.006686
Dim. 1 -0.204263 -0.342156 4.441188
Dim. 20.437211 -2.447078 -0.212327

383

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Columns:
Med
Nur
Psy
Mass
0.281481 0.370370 0.348148
ChiDist 0.108076 0.104352 0.058194
Inertia 0.003288 0.004033 0.001179
Dim. 1 -1.193968 1.227763 -0.340796
Dim. 2
1.061637 0.438859 -1.325217>> # プロット表示> plot(cr2)>>>>> # FactoMineR パッケージを使う方法> library(FactoMineR)>> cr3 <- CA(t2)> cr3**Results of the Correspondence Analysis (CA)**The row variable has 3 categories; the column variable has 3 categories
The chi square of independence between the two variables is equal to 2.294975 (p-value =4 ).
*The results are available in the following objects:
namedescription
1 "$eig""eigenvalues"
2 "$col""results for the columns"
3 "$col$coord""coord. for the columns"
4 "$col$cos2""cos2 for the columns"
5 "$col$contrib""contributions of the columns"
6 "$row""results for the rows"
7 "$row$coord""coord. for the rows"
8 "$row$cos2""cos2 for the rows"
9 "$row$contrib""contributions of the rows"
10 "$call""summary called parameters"
11 "$call$marge.col" "weights of the columns"
12 "$call$marge.row" "weights of the rows"> # プロット表示> plot(cr3)
>
>
>
>
>
>
>

384

0.68168

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多重対応分析
MASS パッケージを使う方法
library(MASS)
オブジェクト名 <- mca(データフレーム名, nf=2)
biplot(オブジェクト名$rs, オブジェクト名$cs, var.axes=F)
カテゴリのみのプロット
plot(オブジェクト名$cs, las=1)
text(オブジェクト名$cs, rownames(オブジェクト名$cs))
MASSパッケージは，Rインストール時に，自動的にインストールされてる。

CA パッケージを用いる方法
library(ca)オブジェクト名 <- mjca(データフレーム名)
plot(オブジェクト名)
あらかじめ ca パッケージをインストールしておく必要がある。

FactoMineR パッケージを使う方法
library(FactoMineR)
オブジェクト名 <- MCA(データフレーム名)
plot(オブジェクト名)
あらかじめ FactoMineR パッケージをインストールしておく必要がある。

> setwd("i:\\Rdocuments\\scripts\\")> d1 <- read.table("統計図表データ.csv", header=T, sep=",", fileEncoding="shift-jis")> head(d1)
番号 入学年度
学科 性別 モラトリアム 自己効力感 学習意欲 進路1
1
20Y1 看護学
女
高
49
23 就職
2
2
20Y2 心理学
男
低
57
29 就職
3
3
20Y1
医学
女
高
42
23 進学
4
4
20Y1 看護学
女
高
41
23 就職
5
5
20Y2
医学
男
低
41
22 就職
6
6
20Y1 心理学
女
低
47
24 就職
>

> # 必要な変数の取り出し> d2 <- d1[,c("入学年度", "学科","進路")]385

名古屋 大学> # 変数のfactor化> for(i in colnames(d2)){+ d2[,i] <- factor(d2[,i])+ }> # 多重対応分析> # MASS パッケージを使う方法> library(MASS)>> mcr1 <- mca(d2, nf=2)> mcr1Call:mca(df = d2, nf = 2)
Multiple correspondence analysis of 270 cases of 3 factors
Correlations 0.659 0.606>

cumulative % explained 32.96 63.24> # プロット表示> biplot(mcr1$rs, mcr1$cs, var.axes=F)># 変数カテゴリととオブザベーションの# 両方が表示される。

> # カテゴリのみ> plot(mcr1$cs, las=1)> text(mcr1$cs, rownames(mcr1$cs))>

386

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> # CA パッケージを用いる方法> library(ca)>> mcr2 <- mjca(d2)> mcr2
Eigenvalues:
1
2
3
Value
0.023097 0.002512 0.000753
Percentage 60.59%
6.59%
1.98%
Columns:
入学年度:20Y1 入学年度:20Y2 入学年度:20Y3 学科:医学 学科:看護学
Mass0.107407
0.120988
0.104938 0.093827
0.123457
ChiDist0.8561420.770249
0.891904 0.928060
0.761002
Inertia
0.078727
0.071780
0.083478 0.080813
0.071497
Dim. 11.209453
0.469473-1.779185 0.480274-0.416871
Dim. 2-0.818424
1.005151-0.321199 -1.622477
0.862505
学科:心理学 進路:就職 進路:進学 進路:不明
Mass
0.116049 0.270370 0.046914 0.016049
ChiDist0.792695 0.282452 1.476909 2.605635
Inertia
0.072921 0.021570 0.102331 0.108965
Dim. 10.055173 0.329027 -2.658654 2.228612
Dim. 2
0.394231 -0.354900 0.340376 4.983760>> # プロット表示> plot(mcr2)>>># 変数カテゴリのみが表示される。

>> # FactoMineR パッケージを使う方法> library(FactoMineR)>> mcr3 <- MCA(d2)> mcr3**Results of the Multiple Correspondence Analysis (MCA)**The analysis was performed on 270 individuals, described by 3 variables*The results are available in the following objects:
1
2
3

name
"$eig""$var""$var$coord"

description"eigenvalues""results for the variables""coord. of the categories"387

名古屋 大学
4 "$var$cos2""cos2 for the categories"
5 "$var$contrib""contributions of the categories"
6 "$var$v.test""v-test for the categories"
7 "$ind""results for the individuals"
8 "$ind$coord""coord. for the individuals"
9 "$ind$cos2""cos2 for the individuals"
10 "$ind$contrib""contributions of the individuals"
11 "$call""intermediate results"
12 "$call$marge.col" "weights of columns"
13 "$call$marge.li" "weights of rows">> # プロット表示> plot(mcr3)>># 変数カテゴリととオブザベーションの# 両方が表示される。

388

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

主成分分析
library(psych)
オブジェクト名 <- principal(データ名, nfactors=因子数, rotate="回転方法")
print(オブジェクト名, sort=TRUE)
スクリープロット
VSS.scree(オブジェクト名)
あらかじめpsychパッケージをインストールしておく必要がある．
データには，素データ，相関係数行列，共分散行列のいずれかを指定する．
回転方法（rotate）
直交回転："none", "varimax", "quartimax"
斜交回転："promax", "oblimin", "simplimax", "cluster"> setwd("d:\\")> d1 <- read.table("因子分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
1
2
3
4
5
6
>
>

x1 x2 x3 x4 x5 x6 x7 x8
3 2 4 4 5 2 3 4
3 2 3 3 3 2 3 2
1 3 1 3 2 2 2 2
3 4 1 3 4 3 4 5
1 3 3 3 4 4 3 4
2 1 3 4 2 2 4 3> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean
SD
x1
x2
x3
x4
x5
x6
x7
x8
x1 346 2.97 1.01 1.00 0.30 0.38 0.27 0.09 0.06 0.08 0.09
x2 346 3.00 1.02 0.30 1.00 0.24 0.17 0.04 0.06 0.01 0.06
x3 346 3.03 1.02 0.38 0.24 1.00 0.19 0.08 0.05 0.03 0.06
x4 346 3.02 1.00 0.27 0.17 0.19 1.00 0.07 0.02 0.05 0.03
x5 346 3.00 1.03 0.09 0.04 0.08 0.07 1.00 0.24 0.32 0.36
x6 346 3.04 1.03 0.06 0.06 0.05 0.02 0.24 1.00 0.19 0.20
x7 346 3.01 1.02 0.08 0.01 0.03 0.05 0.32 0.19 1.00 0.25
x8 346 3.01 1.02 0.09 0.06 0.06 0.03 0.36 0.20 0.25 1.00
>
>

>
>
>
>

# psychパッケージの読み込み
library(psych)# スクリープロット
VSS.scree(d1)389名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 回転を行わない主成分分析> prin.1 <- principal(d1, nfactors=2, rotate="none")> print(prin.1, sort=TRUE)
Principal Components Analysis
Call: principal(r = d1, nfactors = 2, rotate = "none")
Standardized loadings (pattern matrix) based upon correlation matrix
item
PC1
PC2
h2
u2 comutsu
5 0.92 -0.06 0.84 0.16 1.0
result7 0.81 -0.20 0.69 0.31 1.1
stress
2 0.78 0.15 0.63 0.37 1.1
support
4 -0.62 0.28 0.46 0.54 1.4
work
6 0.03 0.64 0.42 0.58 1.0
kyoufu3 0.46 0.63 0.61 0.39 1.8
id
1 -0.09 0.41 0.18 0.82 1.1
PC1 PC2
SS loadings
2.70 1.13
Proportion Var
0.39 0.16
Cumulative Var
0.39 0.55
Proportion Explained 0.71 0.29
Cumulative Proportion 0.71 1.00
Mean item complexity = 1.2
Test of the hypothesis that 2 components are sufficient.
The root mean square of the residuals (RMSR) is 0.13
with the empirical chi square 182.64 with prob < 2.9e-35
Fit based upon off diagonal values = 0.81>
> # varimax回転を行う主成分分析> prin.2 <- principal(d1, nfactors=2, rotate="varimax")> print(prin.2, sort=TRUE)
Principal Components Analysis
Call: principal(r = d1, nfactors = 2, rotate = "varimax")Standardized loadings (pattern matrix) based upon correlation matrix
item
RC1
RC2
h2
u2 comutsu
5 0.92 0.04 0.84 0.16 1.0
result7 0.82 -0.11 0.69 0.31 1.0
stress
2 0.76 0.23 0.63 0.37 1.2
support
4 -0.65 0.21 0.46 0.54 1.2
kyoufu3 0.39 0.68 0.61 0.39 1.6
work
6 -0.04 0.64 0.42 0.58 1.0
id
1 -0.13 0.40 0.18 0.82 1.2
RC1 RC2
SS loadings
2.68 1.15
Proportion Var
0.38 0.16
Cumulative Var
0.38 0.55
Proportion Explained 0.70 0.30
Cumulative Proportion 0.70 1.00
Mean item complexity = 1.2
Test of the hypothesis that 2 components are sufficient.
The root mean square of the residuals (RMSR) is 0.13
with the empirical chi square 182.64 with prob < 2.9e-35
Fit based upon off diagonal values = 0.81

390

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

主成分回帰分析・PLS回帰分析
重回帰分析において，説明変数の数が多いときに，無相関ないくつかの主成分（またはそのようなもの）に説明変数を集約して重回帰分析を行ったとしたときの，もとの説明変数の影響度を推定する方法．
説明変数が非常に多きときに，重要な説明変数を見つけるのに適した分析法．
説明変数を集約するとき，説明変数の主成分を用いる場合を「主成分回帰分析」，基準変数との共分散を最大にするような成分を合成する場合を「PLS回帰分析」と言う．
主成分回帰分析が，説明変数内だけで，より少数の変数に情報をまとめるのに対し，PLS回帰分析では，集約された変数は基準変数と関連が強いのが望ましいという制約を課している点が異なる．
主成分回帰分析は，主成分得点がどう基準変数に影響するかに関心がある「主成分得点を用いた回帰分析」とは，解釈するものが異なる．

主成分回帰分析
library(pls)
オブジェクト名 <- pcr(基準変数名 ~ 変数1，変数2，…, data=データ名)
summary(オブジェクト名)
オブジェクト名$coefficient
あらかじめplsパッケージをインストールしておく必要がある．
主成分数の上限を設定するときは，ncomp=最大主成分数 をオプションに指定する．
PLS回帰分析
library(pls)
オブジェクト名 <- plsr(基準変数名 ~ 変数1，変数2，…, data=データ名)
summary(オブジェクト名)
オブジェクト名$coefficient
あらかじめplsパッケージをインストールしておく必要がある．
主成分数の上限を設定するときは，ncomp=最大主成分数 をオプションに指定する．

> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 記述統計量> dtmp <- d1[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu work result
stress 245 22.94 5.25
1.00
0.40
-0.34 0.62 0.03
0.44
kyoufu 245 4.05 1.17
0.40
1.00
-0.03 0.31 0.10
0.20
support 245 18.42 4.96 -0.34 -0.03
1.00 -0.51 -0.03 -0.39
utsu
245 20.29 6.49
0.62
0.31
-0.51 1.00 0.02
0.76
work
245 0.50 0.50
0.03
0.10
-0.03 0.02 1.00 -0.08
result 245 0.26 0.44
0.44
0.20
-0.39 0.76 -0.08
1.00
>
391

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>>> #標準偏回帰係数の推定> d2 <- as.data.frame(scale(d1[,c("stress","kyoufu","utsu","work")]))> result.2 <- lm(utsu ~ stress + kyoufu + support , data=d2)> summary(result.2)
Call:lm(formula = utsu ~ stress + kyoufu + support, data = d2)
Residuals:
Min
1Q-1.69706 -0.51466

Median0.02535

3Q
0.46419Max
1.81181

Coefficients:
Estimate Std. Error t value Pr(>|t|)(Intercept) 4.497e-17 4.571e-02
0.000
1.0000stress
4.509e-01 5.361e-02
8.411 3.61e-15 ***kyoufu1.210e-01 5.048e-02
2.397
0.0173 *support-3.508e-01 4.907e-02 -7.150 1.03e-11 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7155 on 241 degrees of freedom
Multiple R-squared: 0.4943,
Adjusted R-squared: 0.488
F-statistic: 78.52 on 3 and 241 DF, p-value: < 2.2e-16> confint(result.2)
2.5 %
97.5 %(Intercept) -0.09004947 0.09004947
stress
0.34533426 0.55656020
kyoufu0.02155634 0.22043194
support-0.44749766 -0.25417948> # 主成分回帰分析> library(pls)> res3 <- pcr(utsu ~ stress + kyoufu + support, data=d2)> summary(res3)
Data:
X dimension: 245 3
Y dimension: 245 1
Fit method: svdpc
Number of components considered: 3
TRAINING: % variance explained
1 comps 2 comps 3 comps# その主成分までを用いて何％の分散が説明されるか
X
51.32
83.78
100.00
utsu
45.50
48.92
49.43
> res3$coefficient, , 1 compsutsu
stress
0.3795492
kyoufu0.2963544
support -0.2522451# 第１主成分のみを採用したときの，もとの変数にかかる係数, , 2 compsutsu
stress
0.3778659
kyoufu0.1761000
support -0.3960610# 第２主成分まで採用したときの，もとの変数にかかる係数, , 3 compsutsu
stress0.4509472
kyoufu0.1209941
support -0.3508386# 第３主成分まで採用したときの，もとの変数にかかる係数# もともと３変数なので，重回帰分析の結果と一致する

392

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>>> # PLS 回帰分析
> library(pls)> res4 <- plsr(utsu ~ stress + kyoufu + support, data=d2)> summary(res4)
Data:
X dimension: 245 3
Y dimension: 245 1
Fit method: kernelpls
Number of components considered: 3
TRAINING: % variance explained
1 comps 2 comps 3 comps# その成分までを用いて何％の分散が説明されるか
X
50.74
81.91
100.00
utsu
48.75
49.38
49.43
> res4$coefficient, , 1 compsutsu
stress
0.4093243
kyoufu0.2068089
support -0.3352484# 第１成分のみを採用したときの，もとの変数にかかる係数, , 2 compsutsu
stress
0.4283727
kyoufu0.1324056
support -0.3703227# 第２成分まで採用したときの，もとの変数にかかる係数, , 3 compsutsu
stress0.4509472
kyoufu0.1209941
support -0.3508386# 第３成分まで採用したときの，もとの変数にかかる係数# もともと３変数なので，重回帰分析の結果と一致する

>
>
>

393

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ロジスティック回帰分析 ― 素データ
オブジェクト名 <- glm(基準変数 ~ 説明変数, family=binomial, データフレーム名)
summary(オブジェクト名)glm()でモデルを指定し，結果を「オブジェクト名」に保存する．その内容をsummary()で表示する．
疑似R2乗の推定
library(DescTools)
PseudoR2(オブジェクト名, which="all")
あらかじめ DescTools パッケージをインストールしておく必要がある。
whichで "McFadden", "McFaddenAdj", "CoxSnell", "Nagelkerke", "AldrichNelson", "VeallZimmermann","Efron", "McKelveyZavoina", "Tjur", "all" のいずれかを指定する。すべて出力する場合は"all"とする。
which を指定しない場合は "McFadden" の疑似R2乗が出力される。
> setwd("d:\\")> d1 <- read.table("ロジスティック回帰分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)kyoufu support stress result
1
29
16
28
0
2
27
19
17
1
3
27
16
21
1
4
26
23
22
0
5
26
22
23
1
6
26
20
25
1
>
> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD kyoufu support stress result
kyoufu 245 15.22 5.37
1.00
-0.10
0.43 -0.21
support 245 20.32 6.08 -0.10
1.00 -0.32
0.48
stress 245 18.52 5.12
0.43
-0.32
1.00 -0.39
result 245 0.55 0.50 -0.21
0.48 -0.39
1.00>> # 説明変数の標準化> d2 <- as.data.frame(scale(d1[,c("kyoufu","support","stress")]))> d2 <- data.frame(d2, d1$result)> colnames(d2) <- c("kyoufu","support","stress","result")>>#共分散行列の確認
cov(d2)kyoufusupportstressresultkyoufu1.0000000 -0.1034273 0.4255222 -0.1032508
support -0.1034273 1.0000000 -0.3231937 0.2385116
stress
0.4255222 -0.3231937 1.0000000 -0.1966482
result -0.1032508 0.2385116 -0.1966482 0.2484108> #標準偏回帰係数の推定> result.2 <- glm(result ~ kyoufu + support + stress, family=binomial, d2)> summary(result.2)
Call:glm(formula = result ~ kyoufu + support + stress, family = binomial,
data = d2)
Deviance Residuals:
Min
1Q
Median-2.5189 -0.8689
0.3166

3Q
0.7980Max
2.0672394

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept)
0.30650.15681.954 0.050708 .
kyoufu-0.1587
0.1715 -0.926 0.354625
support1.1552
0.19545.912 3.38e-09 ***stress
-0.76130.1980 -3.845 0.000121 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for binomial family taken to be 1)
Null deviance: 337.09
Residual deviance: 249.58
AIC: 257.58

on 244on 241degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 5> # 疑似R2乗の推定> library(DescTools)> PseudoR2(result.2, which="all")
McFadden
McFaddenAdj
0.2596013
0.2358685
AldrichNelson VeallZimmermann
0.2631759
0.4544564
Tjur
AIC
0.3216345
257.5785243
logLik0
G2-168.5433263
87.5081282

CoxSnellNagelkerke
0.3003507
0.4018721
Efron McKelveyZavoina
0.3294545
0.4449739
BIC
logLik271.5835572-124.7892622> #（標準）偏回帰係数の信頼区間> confint(result.2)
Waiting for profiling to be done...
2.5 %97.5 %(Intercept) 0.002021354 0.6187654
kyoufu-0.498291957 0.1768211
support0.789789998 1.5587577
stress-1.164559209 -0.3850987> #ステップワイズ分析> #MASSパッケージの読み込み> library(MASS)> result.3 <- stepAIC(result.2)
Start: AIC=257.58
result ~ kyoufu + support + stress- kyoufu<none>- stress- support

Df DevianceAIC
1
250.44 256.44
249.58 257.58
1
266.10 272.10
1
295.24 301.24

Step: AIC=256.44
result ~ support + stress<none>- stress- support

Df Deviance
AIC
250.44 256.44
1273.83 277.83
1
295.74 299.74> summary(result.3)
Call:glm(formula = result ~ support + stress, family = binomial, data = d2)
395

名古屋 大学
Deviance Residuals:
Min
1Q
Median-2.4713 -0.8605
0.3192

3Q
0.8171

大 学院 教育発 達科 学研 究科・ 教育 学部

Max
2.1162

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept)
0.30700.15651.961
0.0498 *support1.1502
0.19545.886 3.95e-09 ***stress-0.8292
0.1850 -4.482 7.39e-06 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for binomial family taken to be 1)
Null deviance: 337.09
Residual deviance: 250.44
AIC: 256.44

on 244on 242degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 5396

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ロジスティック回帰分析 ― 集計データ
オブジェクト名 <- glm(割合変数 ~ 独立変数群, data=データフレーム名, weights=ウエイト変数,
family=binomial(link="リンク関数名"))
またはオブジェクト名 <- glm(二値変数 ~ 独立変数群, data=データフレーム名,
family=binomial(link="リンク関数名"))
summary(オブジェクト名)
confint(オブジェクト名)
データが集計されている場合には，独立変数の各水準における事象発生割合を基準変数とし，ウエイト変
数（独立変数の各水準のサイズ）を指定する．
データが集計されていない（0,1のまま）場合には，二値変数を基準変数に用いる．
ランダム成分は二項分布とする．
リンク関数

identity：恒等リンク
logit：
ロジット関数
probit： プロビット関数

線形回帰
ロジスティック回帰
プロビット回帰> # Data from Norton P. G. & Dunn, E. V. (1985). Br. Med. J., 291, 630-632.
> # Agresti,A. (2007). An introduction to categorical data analysis, 2nd ed. Wiley, p69.
> setwd("i:\\Rdocuments\\programs\\")> d1 <- read.table("snoringData.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1$snr <- c(0,2,4,5)> d1$subtotal <- d1$yes + d1$no> d1$pyes <- d1$yes / d1$subtotal> d1

snoring yes
no snr subtotalpyes
1never 24 1355
01379 0.01740392
2 occasional 35 603
2
638 0.05485893
3
nearly 21 192
4
213 0.09859155
4
every 30 224
5254 0.11811024> # GLM> #Binomial(identity) linear regression> result.1 <- glm(pyes ~ snr, data=d1, weights=subtotal,+family=binomial(link="identity"))> summary(result.1)
Call:glm(formula = pyes ~ snr, family = binomial(link = "identity"),
data = d1, weights = subtotal)
Deviance Residuals:
1
2
0.04478 -0.21322

30.11010

40.09798

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept) 0.017247
0.003451
4.998 5.80e-07 ***snr
0.019778
0.002805
7.051 1.77e-12 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1397

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部(Dispersion parameter for binomial family taken to be 1)
Null deviance: 65.904481
Residual deviance: 0.069191
AIC: 24.322

on 3
on 2

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 3> confint(result.1)
Waiting for profiling to be done...
2.5 %97.5 %(Intercept) 0.01132939 0.02483298
snr
0.01451898 0.02550672> #Binomial(logit) logistic regression> result.2 <- glm(pyes ~ snr, data=d1, weights=subtotal,+family=binomial(link="logit"))> summary(result.2)
Call:glm(formula = pyes ~ snr, family = binomial(link = "logit"),
data = d1, weights = subtotal)
Deviance Residuals:
1
2
3-0.8346
1.25210.27584-0.6845

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept) -3.86625
0.16621 -23.261 < 2e-16 ***snr
0.397340.05001
7.945 1.94e-15 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for binomial family taken to be 1)
Null deviance: 65.9045
Residual deviance: 2.8089
AIC: 27.061

on 3
on 2

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 4> confint(result.2)
Waiting for profiling to be done...
2.5 %97.5 %(Intercept) -4.2072190 -3.5544117
snr
0.2999362 0.4963887> #Binomial(probit) probit regression> result.3 <- glm(pyes ~ snr, data=d1, weights=subtotal,+family=binomial(link="probit"))> summary(result.3)
Call:glm(formula = pyes ~ snr, family = binomial(link = "probit"),
data = d1, weights = subtotal)
398

名古屋 大学
Deviance Residuals:
12
3-0.6188
1.03880.1684

大 学院 教育発 達科 学研 究科・ 教育 学部

4-0.6175

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept) -2.06055
0.07017 -29.367 < 2e-16 ***snr
0.18777
0.023487.997 1.28e-15 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for binomial family taken to be 1)
Null deviance: 65.9045
Residual deviance: 1.8716
AIC: 26.124

on 3
on 2

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 4> confint(result.3)
Waiting for profiling to be done...
2.5 %97.5 %(Intercept) -2.2026985 -1.9262643
snr
0.1416397 0.2343393

399

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多項ロジスティック回帰分析
library(VGAM)
オブジェクト名 <- vglm(基準変数 ~ 説明変数, family=multinomial, data=d1)
summary(オブジェクト名)
あらかじめVGAMパッケージをインストールしておく必要がある．
vglm は glm を含む，より一般化された分析モデルである．

> setwd("d:\\")> d1 <- read.table("多項ロジスティック回帰分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
1
2
3
4
5
6

kyoufu support stress result
29
16
28
1
27
19
17
2
27
16
21
2
26
23
22
2
26
22
23
3
26
20
25
2

> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD kyoufu support stress result
kyoufu 245 15.22 5.37
1.00
-0.10
0.43 -0.21
support 245 20.32 6.08 -0.10
1.00 -0.32
0.48
stress 245 18.52 5.12
0.43
-0.32
1.00 -0.39
result 245 0.55 0.50 -0.21
0.48 -0.39
1.00> #偏回帰係数の推定と分析結果の表示> # VGAMパッケージの読み込み> library(VGAM)> result.1 <- vglm(result ~ kyoufu + support + stress,+
family=multinomial, data=d1)> summary(result.1)
Call:vglm(formula = result ~ kyoufu + support + stress, family = multinomial,
data = d1)
Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept):1 0.641363
1.204523
0.532
0.5944(Intercept):2 1.812117
1.021766
1.774
0.0761 .
kyoufu:1
0.052284
0.040671
1.286
0.1986kyoufu:2-0.009506
0.035416 -0.268
0.7884
support:1-0.243084
0.040026 -6.073 1.25e-09 ***support:2-0.131794
0.032755 -4.024 5.73e-05 ***stress:1
0.189729
0.048025
3.951 7.80e-05 ***stress:2
0.080441
0.039218
2.051
0.0403 *--400

名古屋 大学
Signif. codes:

大 学院 教育発 達科 学研 究科・ 教育 学部

0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Names of linear predictors: log(mu[,1]/mu[,3]), log(mu[,2]/mu[,3])Residual deviance: 440.6041 on 482 degrees of freedom
Log-likelihood: -220.302 on 482 degrees of freedom
Number of Fisher scoring iterations: 5
No Hauck-Donner effect found in any of the estimates
Reference group is level3of the response> #標準偏回帰係数の推定> d2 <- as.data.frame(scale(d1[,c("kyoufu","support","stress")]))> d2 <- data.frame(d2,d1$result)> colnames(d2) <- c("kyoufu","support","stress","result")> head(d2)kyoufusupportstress result
1 2.568375 -0.70988932 1.8521250
1
2 2.195706 -0.21672425 -0.2975205
2
3 2.195706 -0.70988932 0.4841688
2
4 2.009371 0.44082919 0.6795911
2
5 2.009371 0.27644083 0.8750134
3
6 2.009371 -0.05233589 1.2658581
2>>#共分散行列の確認
cov(d2)kyoufusupportstressresultkyoufu1.0000000 -0.1034273 0.4255222 -0.1850753
support -0.1034273 1.0000000 -0.3231937 0.3927501
stress
0.4255222 -0.3231937 1.0000000 -0.3303219
result -0.1850753 0.3927501 -0.3303219 0.6432921> result.2 <- vglm(result ~ kyoufu + support + stress,+
family=multinomial, data=d2)> summary(result.2)
Call:vglm(formula = result ~ kyoufu + support + stress, family = multinomial,
data = d2)
Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept):1 0.01211
0.21474
0.056
0.9550(Intercept):2 0.47959
0.18733
2.560
0.0105 *kyoufu:1
0.28059
0.218271.286
0.1986kyoufu:2-0.051020.19007 -0.268
0.7884
support:1-1.47872
0.24348 -6.073 1.25e-09 ***support:2-0.80172
0.19925 -4.024 5.73e-05 ***stress:1
0.97087
0.24575
3.951 7.80e-05 ***stress:2
0.411630.20068
2.051
0.0403 *--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Names of linear predictors: log(mu[,1]/mu[,3]), log(mu[,2]/mu[,3])Residual deviance: 440.6041 on 482 degrees of freedom
401名古屋 大学
Log-likelihood: -220.302 on 482 degrees of freedom
Number of Fisher scoring iterations: 5
No Hauck-Donner effect found in any of the estimates
Reference group is level3of the response>402

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対数線形モデル ― glm関数
データ形式（一覧データ（フラットなクロス表））
テーブル名 <- ftable(データフレーム名[,c("変数名1","変数名2",…)], row.vars=c("変数名1","変数名2",…))
各カテゴリ変数の水準の組み合わせに対する度数の一覧表「sex=F, method=1, grade=A」の度数 = 7など

sex method grade Freq
F
1
A
7
F
1
B
11
F
1
C
2
F
2
A
10
F
2
B
4
F
2
C
4
M
1
A
8
M
1
B
8
M
1
C
7
M
2
A
13
M
2
B
7
M
2
C
16

モデルの指定法
glmオブジェクト名 <- glm(度数変数 ~ 説明変数1 + 説明変数2 + …, family=poisson, データフレーム名)
交互作用の指定法
説明変数名1 : 説明変数名2
説明変数名1 * 説明変数名2# : 区切り … 交互作用のみ# * 区切り … 主効果も含んだ交互作用

パラメタ推定値の表示
summary(glmオブジェクト名)
ステップワイズ分析
library(MASS)AICオブジェクト名 <- stepAIC(glmオブジェクト名)summary(AICオブジェクト名)
MASSパッケージは最初からインストールされている
要因の主効果，交互作用の検討
library(car)Anova(glmオブジェクト名)
あらかじめ car パッケージをインストールしておく必要がある．
Anova は，anova とは異なる関数であることに注意．
残差分析
オブジェクト名 <- glm(度数変数~見たい効果以下の効果変数名の指定, family=poisson,データフレーム名)
モデルによる予測値
xtabs(fitted.values(オブジェクト名) ~ 変数名の指定)
残差・標準化残差（ピアソン）
xtabs(residuals(オブジェクト名, type="pearson") ~ 変数名の指定)
xtabs(rstandard(オブジェクト名, type="pearson") ~ 変数名の指定)
標準化残差の絶対値が大きいセルが，見たい効果が影響しているセルとなる。
デビアンス残差を得るには，type="deviance" とするか，typeの指定を省略する．

403

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("対数線形モデル_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id sex method grade
1 1
F
1
B
2 2
M
1
B
3 3
F
2
A
4 4
M
2
C
5 5
M
2
C
6 6
M
3
A
>
> #クロス表> (t1 <- table(d1[,c("method","grade","sex")], dnn=list("method","grade","sex"))), , sex = F
grade
method A B
1 7 11
2 10 4
3 3 3

C
2
4
2

, , sex = M
grade
method A B C
1 8 8 7
2 13 7 16
3 6 5 6

> #一覧データ> ft1 <- ftable(d1[,c("sex","method","grade")], row.vars=c("sex","method","grade"))> (d2 <- as.data.frame(ft1))
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
>

sex method grade Freq
F
1
A
7
M
1
A
8
F
2
A
10
M
2
A
13
F
3
A
3
M
3
A
6
F
1
B
11
M
1
B
8
F
2
B
4
M
2
B
7
F
3
B
3
M
3
B
5
F
1
C
2
M
1
C
7
F
2
C
4
M
2
C
16
F
3
C
2
M
3
C
6

> #飽和モデル> result.full <- glm(Freq~ method + grade + sex++ sex:method + sex:grade + method:grade++ sex:method:grade, family=poisson, d2)> summary(result.full)Call:glm(formula = Freq ~ method + grade + sex + sex:method + sex:grade +method:grade + sex:method:grade, family = poisson, data = d2)
404

名古屋 大学
Deviance Residuals:[1] 0 0 0 0 0

0

0

0

0

0

0

0

0

0

0

0

0

大 学院 教育発 達科 学研 究科・ 教育 学部

0

Coefficients:

Estimate Std. Error z value Pr(>|z|)(Intercept)
1.945910
0.377964
5.148 2.63e-07 ***method2
0.356675
0.492805
0.724
0.4692
method3-0.847298
0.690066 -1.228
0.2195
gradeB
0.451985
0.483494
0.935
0.3499
gradeC-1.252763
0.801784 -1.562
0.1182sexM
0.133531
0.517549
0.258
0.7964
method2:sexM0.128833
0.666918
0.193
0.8468method3:sexM0.559616
0.876275
0.639
0.5231
gradeB:sexM-0.451985
0.695533 -0.650
0.5158
gradeC:sexM
1.119232
0.954313
1.173
0.2409method2:gradeB-1.368276
0.764046 -1.791
0.0733 .
method3:gradeB-0.451985
0.948911 -0.476
0.6338method2:gradeC
0.336472
0.996422
0.338
0.7356
method3:gradeC
0.847298
1.214985
0.697
0.4856
method2:gradeB:sexM 0.749237
1.026424
0.730
0.4654
method3:gradeB:sexM 0.269664
1.231706
0.219
0.8267method2:gradeC:sexM 0.004699
1.183274
0.004
0.9968method3:gradeC:sexM -0.713766
1.441312 -0.495
0.6204--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for poisson family taken to be 1)
Null deviance: 3.5563e+01
Residual deviance: -2.2013e-25
AIC: 101.28

on 17
on 0

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 3> # 要因の主効果，交互作用の検討> library(car)> Anova(result.full)Analysis of Deviance Table (Type II tests)
Response: Freq
LR Chisq Df Pr(>Chisq)
method
11.0975 2
0.003892 **grade
1.4586 2
0.482244
sex
7.4533 1
0.006332 **method:sex
1.2316 2
0.540205
grade:sex
5.4028 2
0.067110 .
method:grade
6.0188 4
0.197751
method:grade:sex
0.9904 40.911255--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> #ステップワイズ分析> #MASSパッケージの読み込み> library(MASS)> result.aic <- stepAIC(result.full)Start: AIC=101.28
Freq ~ method + grade + sex + sex:method + sex:grade + method:grade +sex:method:grade- method:grade:sex<none>

Df Deviance
AIC
4 0.99035 94.272
0.00000 101.282

Step: AIC=94.27
Freq ~ method + grade + sex + method:sex + grade:sex + method:grade405

名古屋 大学- method:sex- method:grade<none>- grade:sex

大 学院 教育発 達科 学研 究科・ 教育 学部

Df DevianceAIC
2
2.2220 91.504
4
7.0091 92.291
0.9904 94.272
2
6.3932 95.675

Step: AIC=91.5
Freq ~ method + grade + sex + grade:sex + method:grade- method:grade<none>- grade:sex

Df DevianceAIC
4
9.1956 90.477
2.2220 91.504
2
8.5797 93.861

Step: AIC=90.48
Freq ~ method + grade + sex + grade:sex<none>- grade:sex- method

Df Deviance
AIC
9.1956 90.477
2 15.5533 92.835
2 20.2931 97.575> summary(result.aic)Call:glm(formula = Freq ~ method + grade + sex + grade:sex, family = poisson,
data = d2)
Deviance Residuals:
Min
1Q
Median-1.5563 -0.5128
0.10973Q
0.3377Max
1.6722

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept)
1.95290.25517.656 1.91e-14 ***method20.22780.20441.114
0.2651
method3-0.54230.2515 -2.156
0.0311 *gradeB-0.10540.3249 -0.324
0.7457
gradeC-0.9163
0.4183 -2.190
0.0285 *sexM
0.30010.29501.017
0.3090
gradeB:sexM -0.1947
0.4389 -0.444
0.6572
gradeC:sexM
0.98770.49651.989
0.0467 *--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for poisson family taken to be 1)
Null deviance: 35.5627
Residual deviance: 9.1956
AIC: 90.477

on 17
on 10

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 4> # ステップワイズ分析後の要因の主効果，交互作用の検討> Anova(result.aic)
Analysis of Deviance Table (Type II tests)
Response: Freq
LR Chisq Df Pr(>Chisq)
method
11.0975 2
0.003892 **grade
1.4586 2
0.482244
sex
7.4533 1
0.006332 **grade:sex
6.3577 2
0.041634 *--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘

406

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 主効果モデル> result.1 <- glm(Freq ~ method + grade + sex,+family=poisson, d2)> summary(result.1)
Call:glm(formula = Freq ~ method + grade + sex, family = poisson,
data = d2)
Deviance Residuals:
Min
1Q
Median-1.49529 -0.69830 -0.05981

3Q
0.23877

Max
2.28630

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept)
1.83190.22338.203 2.35e-16 ***method20.22780.2044
1.114 0.26507
method3-0.54230.2515 -2.156 0.03106 *gradeB-0.2126
0.2182 -0.974 0.32988
gradeC-0.2392
0.2198 -1.088 0.27637
sexM
0.50210.18682.688 0.00719 **--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for poisson family taken to be 1)
Null deviance: 35.563
Residual deviance: 15.553
AIC: 92.835

on 17
on 12

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 4> Anova(result.1)
Analysis of Deviance Table (Type II tests)
Response: Freq
LR Chisq Df Pr(>Chisq)
method 11.0975 2
0.003892 **grade
1.4586 2
0.482244
sex
7.4533 1
0.006332 **--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> # sex;grade の交互作用を見るための残差分析> #主効果とsex:method, method:gradeの交互作用までを仮定したモデル> result.2 <- glm(Freq~ sex + method + grade + sex:method + method:grade, family=poisson, d2)> summary(result.2)
Call:glm(formula = Freq ~ sex + method + grade + sex:method + method:grade,family = poisson, data = d2)
Deviance Residuals:
Min
1Q-1.19065 -0.32089
Coefficients:(Intercept)
sexM
method2
method3
gradeB
gradeC
sexM:method2
sexM:method3

Median0.00029

3Q
0.25977

Max
0.93241

Estimate Std. Error z value Pr(>|z|)1.94260.30566.356 2.07e-10 ***0.13980.30570.457
0.6476
0.09430.41700.226
0.8211-0.88480.5381 -1.644
0.1001
0.23640.34540.684
0.4937-0.5108
0.4216 -1.212
0.22570.55340.42051.316
0.18820.61400.52661.166
0.2436407

名古屋 大学
method2:gradeB
method3:gradeB
method2:gradeC
method3:gradeC--Signif. codes:-0.9740-0.35420.3711
0.39300.50370.59620.52080.6433-1.934-0.5940.712
0.611

大 学院 教育発 達科 学研 究科・ 教育 学部

0.0531 .
0.55250.47620.54120 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for poisson family taken to be 1)
Null deviance: 35.5627
Residual deviance: 6.3932
AIC: 95.675

on 17
on 6

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 4> # 予測値> xtabs(fitted.values(result.2) ~ sex + grade + method , data=d2), , method = 1
sex
F
M

grade

A
B
6.976744 8.837209
8.023256 10.162791

C
4.186047
4.813953, , method = 2
grade
sex
A
F 7.666667
M 15.333333

BC
3.666667 6.666667
7.333333 13.333333, , method = 3
sex
F
M

grade
A
2.880000
6.120000

B
2.560000
5.440000

C
2.560000
5.440000> # 残差（ピアソン）> xtabs(residuals(result.2, type="pearson") ~ sex + grade + method, data=d2), , method = 1
grade
sex
A
B
C
F 0.008804509 0.727540078 -1.068457799
M -0.008210247 -0.678434621 0.996342033, , method = 2
grade
sex
A
B
C
F 0.842700972 0.174077656 -1.032795559
M -0.595879572 -0.123091491 0.730296743, , method = 3
grade
sex
A
B
C
F 0.070710678 0.275000000 -0.350000000
M -0.048507125 -0.188648444 0.240098019> # 標準化残差（ピアソン）> xtabs(rstandard(result.2, type="pearson") ~ sex + grade + method, data=d2), , method = 1
grade
sex
A
B
C
F 0.01491867 1.33154217 -1.64294963
M -0.01491865 -1.33154032 1.64294735
408

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部, , method = 2
grade
sex
A
B
C
F 1.36218225 0.23891939 -1.59410745
M -1.36218123 -0.23891921 1.59410626, , method = 3
grade
sex
A
B
C
F 0.10718662 0.40441176 -0.51470588
M -0.10718662 -0.40441176 0.51470588> xtabs(rstandard(result.2, type="pearson") ~ sex + grade, data=d2)
grade
sex
A
B
C
F 1.484288 1.974873 -3.751763
M -1.484286 -1.974871 3.751759>> xtabs(residuals(result.2, type="pearson") ~ sex + method, data=d2)
methodsex
1
2
3
F -0.332113212 -0.016016931 -0.004289322
M 0.309697165 0.011325681 0.002942451>> xtabs(residuals(result.2, type="pearson") ~ grade + method, data=d2)
methodgrade
1
2
3
A 0.000594262 0.246821400 0.022203553
B 0.049105457 0.050986165 0.086351556
C -0.072115766 -0.302498816 -0.109901981> # 標準化残差（デビアンス）> xtabs(rstandard(result.2, type="deviance") ~ sex + grade + method, data=d2), , method = 1
grade
sex
A
B
C
F 0.01491039 1.28211793 -1.83084729
M -0.01492587 -1.38352865 1.53752401, , method = 2
grade
sex
A
B
C
F 1.30060957 0.23543000 -1.72341213
M -1.39912435 -0.24076438 1.54496236, , method = 3
grade
sex
A
B
C
F 0.10645490 0.39358552 -0.53542276
M -0.10753979 -0.41005579 0.50623366> xtabs(rstandard(result.2) ~ sex + grade, data=d2)
grade
sex
A
B
C
F 1.421975 1.911133 -4.089682
M -1.521590 -2.034349 3.588720

409

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

対数線形モデル ― loglm関数
データ形式（テーブルデータ

または一覧データ）

テーブルデータ（クロス表）
テーブル名 <- table(データフレーム名[,c("変数名1","変数名2",…)], dnn=c("変数名1","変数名2",…))
一覧データ（フラットなクロス表）
テーブル名 <- ftable(データフレーム名[,c("変数名1","変数名2",…)], row.vars=c("変数名1","変数名2",…))
各カテゴリ変数の水準の組み合わせに対する度数の一覧表「sex=F, method=1, grade=A」の度数 = 7など

sex method grade Freq
F
1
A
7
F
1
B
11
F
1
C
2
F
2
A
10
F
2
B
4
F
2
C
4
M
1
A
8
M
1
B
8
M
1
C
7
M
2
A
13
M
2
B
7
M
2
C
16
モデルの指定法
テーブルデータを使う場合
library(MASS)
オブジェクト名 <- loglm( ~ 変数1 +変数2 + 変数1:変数2 + …, テーブル名)
一覧データを使う場合
library(MASS)
オブジェクト名 <- loglm(度数変数 ~ 説明変数1 + 説明変数2 + 変数1:変数2 + …, データフレーム名)
MASSパッケージは最初からインストールされている交互作用の指定法
説明変数名1 : 説明変数名2
説明変数名1 * 説明変数名2# : 区切り … 交互作用のみ# * 区切り … 主効果も含んだ交互作用

パラメタ推定値の表示
coef(オブジェクト名)
ステップワイズ分析
library(MASS)AICオブジェクト名 <- stepAIC(loglmオブジェクト名)
coef(AICオブジェクト名)
尤度比検定
anova(loglmオブジェクト名1, loglmオブジェクト名2)
AICオブジェクト名も設定可能
一覧データを用いた場合は，モデルの記述に不具合が生じるようだが，計算は正しくしてくれる
残差分析
テーブルデータを使う場合
オブジェクト名 <- loglm(~変数名の指定, テーブル名)
一覧データを使う場合
オブジェクト名 <- loglm(度数変数~変数名の指定, データフレーム名)
観測値のモデル予測からのデビアンス残差の表
apply(residuals(オブジェクト名), c(配列の次元を指定), sum)410

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> setwd("d:\\")> d1 <- read.table("対数線形モデル_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id sex method grade
1 1
F
1
B
2 2
M
1
B
3 3
F
2
A
4 4
M
2
C
5 5
M
2
C
6 6
M
3
A
>
> #クロス表> (t1 <- table(d1[,c("method","grade","sex")], dnn=list("method","grade","sex"))), , sex = F
grade
method A B
1 7 11
2 10 4
3 3 3

C
2
4
2

, , sex = M
grade
method A B C
1 8 8 7
2 13 7 16
3 6 5 6>
> #一覧データ> ft1 <- ftable(d1[,c("sex","method","grade")], row.vars=c("sex","method","grade"))> (d2 <- as.data.frame(ft1))
sex method grade Freq
1
F
1
A
7
2
M
1
A
8
3
F
2
A
10
4
M
2
A
13
5
F
3
A
3
6
M
3
A
6
7
F
1
B
11
8
M
1
B
8
9
F
2
B
4
10
M
2
B
7
11
F
3
B
3
12
M
3
B
5
13
F
1
C
2
14
M
1
C
7
15
F
2
C
4
16
M
2
C
16
17
F
3
C
2
18
M
3
C
6
>
>
> #MASSパッケージの読み込み> library(MASS)>>> # 飽和モデル> result.full <- loglm(~ method + grade + sex++ sex:method + sex:grade + method:grade++ sex:method:grade, t1)> # または> # result.full <- loglm(Freq~ method + grade + sex> #+ sex:method + sex:grade + method:grade> #+ sex:method:grade, d2)>> coef(result.full)$`(Intercept)`[1] 1.75465
411

名古屋 大学$method10.1023078230.3051205 -0.4074284$gradeA
B
C
0.209226512 -0.001717884 -0.207508628$sex
F-0.3099278

M
0.3099278$method.grade
grade
methodA
B
C
1 -0.05350831 0.38342865 -0.3299203
2 0.16477037 -0.39195020 0.2271798
3 -0.11126207 0.00852155 0.1027405$method.sex
sexmethodFM
1 0.13195435 -0.13195435
2 -0.05811795 0.05811795
3 -0.07383640 0.07383640$grade.sex
sex
grade
F
M
A 0.1284206 -0.1284206
B 0.1845965 -0.1845965
C -0.3130172 0.3130172$method.grade.sex, , sex = F
grade
methodA
B
C
1 -0.01721290 0.15260380 -0.13539089
2 0.10844296 -0.09635866 -0.01208429
3 -0.09123005 -0.05624513 0.14747519, , sex = M
grade
methodA
B
C
1 0.01721290 -0.15260380 0.13539089
2 -0.10844296 0.09635866 0.01208429
3 0.09123005 0.05624513 -0.14747519> # 飽和モデルの残差> residuals(result.full)
Re-fitting to get frequencies and fitted values, , sex = F
grade
method A B C
1 0 0 02 0 0 03 0 0 0, , sex = M
grade
method A B C
1 0 0 02 0 0 03 0 0 0>412

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> # ステップワイズ分析> (result.aic <- stepAIC(result.full))Start: AIC=36~method + grade + sex + sex:method + sex:grade + method:grade +sex:method:grade- method:grade:sex<none>Df
AIC
4 28.99
36.00

Step: AIC=28.99~method + grade + sex + method:sex + grade:sex + method:grade- method:sex- method:grade<none>- grade:sex

Df
AIC
2 26.222
4 27.009
28.9902 30.393

Step: AIC=26.22~method + grade + sex + grade:sex + method:grade- method:grade<none>- grade:sex

Df
AIC
4 25.196
26.222
2 28.580

Step: AIC=25.2~method + grade + sex + grade:sex
Df
AIC<none>
25.196- grade:sex 2 27.553- method
2 32.293
Call:loglm(formula = ~method + grade + sex + grade:sex, data = t1,
evaluate = FALSE)
Statistics:
X^2 df P(> X^2)
Likelihood Ratio 9.195595 10 0.5136471
Pearson9.224254 10 0.5109616> coef(result.aic)$`(Intercept)`[1] 1.789734$method10.1048468

2
30.3326307 -0.4374775$gradeA
0.208382813

BC
0.005650259 -0.214033071$sex
F-0.2822199

M
0.2822199$grade.sex
sex
grade
F
M
A 0.1321676 -0.1321676
B 0.2295396 -0.2295396
C -0.3617072 0.3617072>
413

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> # 主効果モデル> result.1 <- loglm(~ method + grade + sex, t1)> # または> #result.1 <- loglm(Freq ~ method + grade + sex, d2)>>> # sex;grade の交互作用効果を見るための残差分析> #sex:method, method:gradeの交互作用までを仮定したモデル> result.2 <- loglm(~ method + grade + sex++ sex:method + method:grade, t1)> # 尤度比検定> anova(result.1, result.2)
LR tests for hierarchical log-linear models
Model 1:~method + grade + sex
Model 2:
Freq ~ grade + method + sex + grade:sex
Deviance df Delta(Dev) Delta(df) P(> Delta(Dev)
Model 1
15.553284 12
Model 2
6.393183 69.16010160.16477
Saturated 0.000000 0
6.39318360.38062>>> # sex:grade の交互作用を見るための残差分析> #主効果とsex:method, method:gradeの交互作用までを仮定したモデル>> result.2 <- loglm(~ sex + method + grade + sex:method + method:grade, t1)> # または> #result.2 <- loglm(Freq~ method + grade + sex + sex:method + method:grade, d2)>> coef(result.2)$`(Intercept)`[1] 1.78938$method10.1316042

2
30.3016217 -0.4332260$gradeA
B
C
0.15415153 -0.05217953 -0.10197200$sex
F-0.2644468

M
0.2644468$method.grade
grade
methodA
B
C
1 -0.06267259 0.38004726 -0.31737467
2 0.13830209 -0.39296578 0.25466369
3 -0.07562951 0.01291852 0.06271099$method.sex
sexmethodFM
1 0.19456585 -0.19456585
2 -0.08212677 0.08212677
3 -0.11243908 0.11243908>
414

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #予測値> fitted.values(result.2)
Re-fitting to get fitted values, , sex = F
grade
methodA
B
C
1 6.976744 8.837209 4.186047
2 7.666667 3.666667 6.666667
3 2.880000 2.560000 2.560000, , sex = M
grade
methodA
B
C
1 8.023256 10.162791 4.813953
2 15.333333 7.333333 13.333333
3 6.120000 5.440000 5.440000>>> #ピアソン残差> residuals(result.2, type="pearson")
Re-fitting to get frequencies and fitted values, , sex = F
grade
method1
2
3

A
0.008804509
0.842700972
0.070710678

BC
0.727540078 -1.068457799
0.174077656 -1.032795559
0.275000000 -0.350000000, , sex = M
grade
methodAB
1 -0.008210247 -0.678434621
2 -0.595879572 -0.123091491
3 -0.048507125 -0.188648444

C
0.996342035
0.730296743
0.240098019>> apply(residuals(result.2, type="pearson"), c("sex","grade"), sum)
Re-fitting to get frequencies and fitted values
grade
sex
A
B
C
F 0.9222162 1.1766177 -2.451253
M -0.6525969 -0.9901746 1.966737>>>>> #デビアンス残差> residuals(result.2)
Re-fitting to get frequencies and fitted values, , sex = F
method
1
2
3

grade
A
0.008799624
0.804609625
0.070227965

BC
0.700535218 -1.190653100
0.171535271 -1.116569901
0.267638153 -0.364087473, , sex = M
grade
method

A

B

C
415

名古屋 大学
1 -0.008214218 -0.704923252
2 -0.612040160 -0.124042121
3 -0.048666954 -0.191281248

0.932409555
0.707782794
0.236145930> apply(residuals(result.2), c("sex","grade"), sum)
Re-fitting to get frequencies and fitted values
grade
sex
A
B
C
F 0.8836372 1.139709 -2.671310
M -0.6689213 -1.020247 1.876338

416

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

カウントデータの分析
ポアソンモデルオブジェクト名 <- glm(計数変数 ~ 独立変数 + offset(log(全体数変数)), data=データフレーム名,
family=poisson(link="log"))
負の二項分布モデル
library(MASS)
オブジェクト名 <- glm.nb(計数変数 ~ 独立変数 + offset(log(全体数変数)), data=データフレーム名,
link=log)
summary(オブジェクト名)
confint(オブジェクト名)> # Data from British department of transport.
> # Agresti,A. (2007). An introduction to categorical data analysis, 2nd ed. Wiley, p83.
> setwd("i:\\Rdocuments\\programs\\")>> d1 <- read.table("collisionsData.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1$x <- d1$year - 1975
> head(d1)year trainKm collTT collTR x
1 2003518
0
3 28
2 2002516
1
3 27
3 2001508
0
4 26
4 2000503
1
3 25
5 1999505
1
2 24
6 1998487
0
4 23>> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN
Mean
SD year trainKm collTT collTR
xyear
29 1989.00 8.51 1.00
0.72 -0.56 -0.34 1.00
trainKm 29 440.00 38.68 0.72
1.00 -0.44 -0.26 0.72
collTT 29
1.66 1.32 -0.56-0.44
1.00 -0.03 -0.56
collTR 29
4.21 2.81 -0.34-0.26 -0.03
1.00 -0.34
x29
14.00 8.51 1.00
0.72 -0.56 -0.34 1.00>>> # GLM>> #Poisson loglinear> result.1 <- glm(collTR ~ x + offset(log(trainKm)), data=d1,+
family=poisson(link="log"))> summary(result.1)
Call:glm(formula = collTR ~ x + offset(log(trainKm)), family = poisson(link = "log"),data = d1)
Deviance Residuals:
Min
1Q
Median-2.0580 -0.7825 -0.0826

3Q
0.3775Max
3.3873

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept) -4.21142
0.15892 -26.50 < 2e-16 ***x-0.03292
0.01076-3.06 0.00222 **--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1417

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部(Dispersion parameter for poisson family taken to be 1)
Null deviance: 47.376
Residual deviance: 37.853
AIC: 133.52

on 28
on 27

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 5> confint(result.1)
Waiting for profiling to be done...
2.5 %97.5 %(Intercept) -4.5342219 -3.9105409
x-0.0542105 -0.0119652>>> # Negative binomial loglinear> library(MASS)> result.2 <- glm.nb(collTR ~ x + offset(log(trainKm)), data=d1,+
link=log)> summary(result.2)
Call:
glm.nb(formula = collTR ~ x + offset(log(trainKm)), data = d1,
link = log, init.theta = 10.11828724)
Deviance Residuals:
Min
1Q
Median-1.72370 -0.65461 -0.05868

3Q
0.32984Max
2.64065

Coefficients:
Estimate Std. Error z value Pr(>|z|)(Intercept) -4.19999
0.19584 -21.446 < 2e-16 ***x-0.03367
0.01288 -2.615 0.00893 **--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1(Dispersion parameter for Negative Binomial(10.1183) family taken to be 1)
Null deviance: 32.045
Residual deviance: 25.264
AIC: 132.69

on 28
on 27

degrees of freedom
degrees of freedom

Number of Fisher Scoring iterations: 1
Theta:
Std. Err.:2 x log-likelihood:

10.12
8.00
-126.69> confint(result.2)
Waiting for profiling to be done...
2.5 %97.5 %(Intercept) -4.593077 -3.815438383
x-0.059499 -0.008290411>

418

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

階層線形モデルの例
ランダム切片モデル
レベル1の回帰式（基準変数の回帰式）
y = b0 + b1 * support + e# 説明変数は，群ごとに平均偏差化しておくことが多い

レベル2の回帰式（回帰係数の回帰式）
b0 = g00 + g01 * rooms + g02 * futoukou + u0

# ランダム切片

回帰式の統合y = (g00 + g01 * rooms + g02 * futoukou + u0) + b1 * support + e= (g00 + g01 * rooms + g02 * futoukou + b1 * support) + (u0 + e)
固定効果
g00 … (Intercept)
g01 … rooms
g02 … futoukou
b1 … support

変量効果
u0 … (Intercept)e … (Residual)

ランダム切片・ランダムスロープモデル １
レベル1の回帰式（基準変数の回帰式）
y = b0 + b1 * support + e
レベル2の回帰式（回帰係数の回帰式）
b0 = g00 + g01 * rooms + g02 * futoukou + u0
b1 = g10 + u1

# ランダム切片# ランダムスロープ

回帰式の統合y = (g00 + g01 * rooms + g02 * futoukou + u0) +(g10 + u1) * support + e= (g00 + g01 * rooms + g02 * futoukou + g10 * support) + (u0 + u1 * support + e)
固定効果
g00 … (Intercept)
g01 … rooms
g02 … futoukou
g10 … support

変量効果
u0 … (Intercept)
u1 … supporte … (Residual)

ランダム切片・ランダムスロープモデル ２
レベル1の回帰式（基準変数の回帰式）
y = b0 + b1 * support + e
レベル2の回帰式（回帰係数の回帰式）
b0 = g00 + g01 * rooms + g02 * futoukou + u0
b1 = g10 + g11 * rooms + g12 * futoukou + u1

# ランダム切片# ランダムスロープ

回帰式の統合y = (g00 + g01 * rooms + g02 * futoukou + u0) +(g10 + g11 * rooms + g12 * futoukou + u1) * support + e= (g00 + g01 * rooms + g02 * futoukou + g10 * support +g11 * rooms * support + g12 * futoukou * support) + (u0 + u1 * support + e)
固定効果
g00 … (Intercept)
g01 … rooms
g02 … futoukou
g10 … support
g11 … rooms * support
g12 … futoukou * support

変量効果
u0 … (Intercept)
u1 … supporte … (Residual)

419

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Ｒで階層線形モデル分析をするためのデータ構造
レベル1とレベル2のデータを統合した１つのデータが必要である．
レベル1データ

レベル2の情報をレベル1に統合したデータ

レベル2データ

説明変数の平均偏差データ化
階層線形モデルでは，群ごとに，低階層の説明変数を平均偏差データ化して分析することが多い．
所属する群における説明変数の値が入った変数の生成
群平均変数名 <- ave(説明変数名, 群分け変数名)
平均偏差化説明変数名 <- 説明変数名 - 群平均変数名420

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

階層線形モデル ― lmer関数
lme4パッケージの読み込み
library(lme4)
ランダム切片モデル
オブジェクト名1 <- lmer(基準変数 ~ 固定効果説明変数+ (1 | 群分け変数), data=データフレーム名)
summary(オブジェクト名1)
ランダム切片・ランダムスロープモデル
オブジェクト名1 <- lmer(基準変数 ~ 固定効果説明変数+ (1+レベル1の説明変数 | 群分け変数), data=データフレーム名)
summary(オブジェクト名2)
ランダム切片・ランダムスロープモデル，相関の推定なし
オブジェクト名3 <- lmer(基準変数 ~ 固定効果説明変数+ (1 | 群分け変数) + (0+レベル1の説明変数 | 群分け変数),
data=データフレーム名)
summary(オブジェクト名3)モデルの適合度の比較
anova(オブジェクト名1, オブジェクト名2, …)
あらかじめlme4パッケージをインストールしておく必要がある．
「(1 | 群分け変数)」で，ランダム切片の変量効果変数を表す．
「(1+レベル1の説明変数 | 群分け変数)」で，ランダム切片・ランダムスロープの変量効果変数を表す．
切片とスロープの相関係数を推定する場合は「1+」を省略してもよい．
「(0+レベル1の説明変数 | 群分け変数)」で，ランダムスロープの変量効果変数を表す．
「0+」とすると，切片とスロープの相関係数は推定されない．
【注意】：lmerを用いた場合は，切片とスロープの相関の推定がうまくいかないことがある．
固定効果の異なるモデル間でも，適合度の比較ができる．

> setwd("d:\\")>> # レベル1のデータの読み込み> d1 <- read.table("階層線形モデル_データ1.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
1
2
3
4
5
6
>

id school support kenkou
1
a
5
8
2
a
10
7
3
a
14
8
4
a
11
8
5
a
14
7
6
a
10
6

> # 記述統計量> library(psych)> describeBy(d1[,c("support","kenkou")], d1[,c("school")], mat=TRUE, digits=2)
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
sesupport1
1a
1 40 9.70 3.23
10.0
9.84 4.45
1 14
13 -0.40-0.63 0.51
support22b
1 40 9.28 3.34
9.0
9.28 2.97
2 16
14 0.00-0.67 0.53
support33c
1 40 11.15 2.63
11.0
11.41 2.97
4 15
11 -0.74
0.06 0.42
support44d
1 40 10.68 2.84
10.5
10.66 3.71
5 17
12 0.08-0.88 0.45
support55e
1 40 10.28 2.63
10.0
10.22 2.97
5 17
12 0.28-0.31 0.42
support6
6f
1 40 10.50 3.35
10.5
10.38 2.97
4 18
14 0.39-0.22 0.53421

名古屋 大学
support7
support8
kenkou1
kenkou2
kenkou3
kenkou4
kenkou5
kenkou6
kenkou7
kenkou8
>

7
8
9
10
11
12
13
14
15
16

g
h
a
b
c
d
e
f
g
h

1 40 9.80 2.36
1 40 9.20 2.15
2 40 9.38 3.07
2 40 11.43 3.13
2 40 13.05 3.01
2 40 13.22 3.32
2 40 13.75 3.43
2 40 15.43 3.03
2 40 15.75 3.05
2 40 16.38 2.39

10.0
9.0
9.0
12.0
12.5
13.0
14.0
15.0
16.0
16.0

9.97 2.97
9.31 1.48
9.19 2.97
11.38 2.97
12.94 2.97
13.28 2.97
14.03 2.97
15.50 2.97
15.72 2.97
16.25 2.97

大 学院 教育発 達科 学研 究科・ 教育 学部
3
3
3
5
7
7
4
8
10
12

14
13
18
19
20
20
21
21
22
22

11 -0.68
10 -0.57
15 0.56
14 0.05
13 0.34
13 -0.18
17 -0.71
13 -0.26
12 0.02
10 0.43

0.16 0.37
0.36 0.34
0.06 0.49-0.35 0.49
-0.41 0.48
-0.60 0.52
0.74 0.54-0.45 0.48
-0.93 0.48
-0.38 0.38

> # 各群の相関係数行列> by(d1[,c("support","kenkou")], d1$school, cor)
d1$school: asupportkenkousupport 1.0000000 -0.1151671
kenkou -0.1151671 1.0000000--------------------------------------------------------d1$school: b
supportkenkousupport 1.0000000 -0.1072993
kenkou -0.1072993 1.0000000--------------------------------------------------------d1$school: csupportkenkousupport 1.0000000 -0.1370703
kenkou -0.1370703 1.0000000--------------------------------------------------------d1$school: dsupportkenkousupport 1.0000000 0.4814743
kenkou 0.4814743 1.0000000--------------------------------------------------------d1$school: esupportkenkousupport 1.0000000 0.2888883
kenkou 0.2888883 1.0000000--------------------------------------------------------d1$school: f
supportkenkousupport 1.0000000 0.2690342
kenkou 0.2690342 1.0000000--------------------------------------------------------d1$school: g
supportkenkousupport 1.0000000 0.3672454
kenkou 0.3672454 1.0000000--------------------------------------------------------d1$school: hsupportkenkousupport 1.0000000 0.4632841
kenkou 0.4632841 1.0000000>> # 群ごとに，説明変数を平均偏差データ化> d1$support.gmean <- ave(d1$support, d1$school)> d1$support.gcen <- d1$support - d1$support.gmean> head(d1)
1
2
3
4
5
6
>

id school support kenkou support.gmean support.gcen
1
a
5
8
9.7
-4.7
2
a
10
7
9.7
0.3
3
a
14
8
9.7
4.3
4
a
11
8
9.7
1.3
5
a
14
7
9.7
4.3
6
a
10
6
9.7
0.3
422

# レベル1のデータに群平均の列を追加# 個人データから群平均を引いた変数の作成

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # レベル2のデータの読み込み> d2 <- read.table("階層線形モデル_データ2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")
> d2
1
2
3
4
5
6
7
8
>

school rooms futoukou
a
3
0
b
1
1
c
2
2
d
5
2
e
4
3
f
5
4
g
7
5
h
3
6

> # レベル2データの情報をレベル1データに反映したデータの作成> d3 <- merge(d1,d2, by="school")#「by」で指定した変数をキーとして，レベル2のデータを追加> d3 <- d3[order(d3$id),]> head(d3)
1
2
3
4
5
6
>
>
>

school id support kenkou support.gmean support.gcen rooms futoukou
a 1
5
8
9.7
-4.7
3
0
a 2
10
7
9.7
0.3
3
0
a 3
14
8
9.7
4.3
3
0
a 4
11
8
9.7
1.3
3
0
a 5
14
7
9.7
4.3
3
0
a 6
10
6
9.7
0.3
3
0

> # lmer関数を使う方法> #lme4パッケージの読み込み> library(lme4)>423

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # ランダム切片モデル> result.lmer0 <- lmer(kenkou ~ support.gcen + rooms + futoukou++ (1 | school),+
data=d3)> summary(result.lmer0)
Linear mixed model fit by REML
Formula: kenkou ~ support.gcen + rooms + futoukou + (1 | school)
Data: d3
AIC BIC logLik deviance REMLdev
1640 1663 -814.1
1619
1628
Random effects:
GroupsName
Variance Std.Dev.
school(Intercept) 0.23613 0.48593# ランダム切片（u0）の分散
Residual
9.18282 3.03032# ランダム誤差（e） の分散
Number of obs: 320, groups: school, 8# 固定効果Fixed effects:
Estimate Std. Error t value(Intercept) 10.14209
0.57510 17.635
support.gcen 0.17821
0.06026
2.957
rooms
0.07732
0.15674
0.493
futoukou
1.083420.14729
7.356
Correlation of Fixed Effects:(Intr) spprt. rooms
support.gcn 0.000
rooms-0.649 0.000
futoukou-0.218 0.000 -0.507
>
>

424

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # ランダム切片・ランダムスロープモデル 1 相関の推定なし> result.lmer1 <- lmer(kenkou ~ support.gcen + rooms + futoukou++ (1 | school) + (0+support.gcen | school),+
data=d3)> summary(result.lmer1)
Linear mixed model fit by REML
Formula: kenkou ~ support.gcen + rooms + futoukou + (1 | school) + (0 + support.gcen | school)
Data: d3
AIC BIC logLik deviance REMLdev
1635 1662 -810.6
1613
1621
Random effects:
GroupsName
Variance Std.Dev.
school(Intercept) 0.246992 0.49698# ランダム切片（u0）の分散
schoolsupport.gcen 0.062756 0.25051# ランダムスロープ（u1）の分散
Residual
8.748394 2.95777# ランダム誤差（e） の分散
Number of obs: 320, groups: school, 8
Fixed effects:
Estimate Std. Error t value(Intercept) 10.14209
0.57517 17.633
support.gcen 0.20971
0.10736
1.953
rooms
0.07732
0.15676
0.493
futoukou
1.083420.147317.355# 固定効果Correlation of Fixed Effects:(Intr) spprt. rooms
support.gcn 0.000
rooms-0.649 0.000
futoukou-0.218 0.000 -0.507>> # ランダム切片・ランダムスロープモデル 1 相関の推定あり> result.lmer2 <- lmer(kenkou ~ support.gcen + rooms + futoukou++ (1+support.gcen | school),+
data=d3)> summary(result.lmer2)
Linear mixed model fit by REML
Formula: kenkou ~ support.gcen + rooms + futoukou + (1 + support.gcen | school)
Data: d3
AIC BIC logLik deviance REMLdev
1637 1667 -810.6
1613
1621
Random effects:
GroupsName
Variance Std.Dev. Corr
school(Intercept) 0.259881 0.50979# ランダム切片（u0）の分散
support.gcen 0.060644 0.24626 0.366# ランダムスロープ（u1）の分散
Residual
8.752990 2.95855# ランダム誤差（e） の分散
Number of obs: 320, groups: school, 8
Fixed effects:
Estimate Std. Error t value(Intercept) 10.38923
0.57129 18.186
support.gcen 0.20797
0.10611
1.960
rooms
0.03605
0.15519
0.232
futoukou
1.051300.14594
7.204# 固定効果Correlation of Fixed Effects:(Intr) spprt. rooms
support.gcn 0.104
rooms-0.645 0.003
futoukou-0.217 -0.016 -0.508
>
>

425

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # ランダム切片・ランダムスロープモデル 2 相関の推定なし> result.lmer3 <- lmer(kenkou ~ support.gcen + rooms + futoukou++ (support.gcen * rooms) + (support.gcen * futoukou)++ (1 | school) + (0+support.gcen | school),+
data=d3)> summary(result.lmer3)
Linear mixed model fit by REML
Formula: kenkou ~ support.gcen + rooms + futoukou + (support.gcen * rooms) + (support.gcen * futoukou) + (1 | school) + (0 + support.gcen | school)
Data: d3
AIC BIC logLik deviance REMLdev
1641 1674 -811.3
1605
1623
Random effects:
GroupsName
Variance Std.Dev.
school(Intercept) 0.246920 0.49691# ランダム切片（u0）の分散
schoolsupport.gcen 0.011578 0.10760# ランダムスロープ（u1）の分散
Residual
8.751276 2.95826# ランダム誤差（e） の分散
Number of obs: 320, groups: school, 8
Fixed effects:# 固定効果Estimate Std. Error t value(Intercept)
10.14209
0.57517 17.633
support.gcen-0.27189
0.16320 -1.666
rooms
0.07732
0.15676
0.493
futoukou
1.083420.14731
7.355
support.gcen:rooms
0.08166
0.04855
1.682
support.gcen:futoukou 0.06393
0.04687
1.364
Correlation of Fixed Effects:(Intr) spprt. rooms futouk spprt.gcn:r
support.gcn 0.000
rooms-0.649 0.000
futoukou-0.218 0.000 -0.507
spprt.gcn:r 0.000 -0.661 0.000 0.000
spprt.gcn:f 0.000 -0.130 0.000 0.000 -0.567>>> # ランダム切片・ランダムスロープモデル 2 相関の推定あり> result.lmer4 <- lmer(kenkou ~ support.gcen + rooms + futoukou++ (support.gcen * rooms) + (support.gcen * futoukou)++ (1+support.gcen | school),+
data=d3)> summary(result.lmer4)
Linear mixed model fit by REML
Formula: kenkou ~ support.gcen + rooms + futoukou + (support.gcen * rooms) + (support.gcen * futoukou) + (1 + support.gcen | school)
Data: d3
AIC BIC logLik deviance REMLdev
1643 1680 -811.3
1605
1623
Random effects:
GroupsName
Variance Std.Dev. Corr
school(Intercept) 0.246910 0.49690# ランダム切片（u0）の分散
support.gcen 0.011382 0.10668 0.203# ランダムスロープ（u1）の分散
Residual
8.751965 2.95837# ランダム誤差（e） の分散
Number of obs: 320, groups: school, 8
Fixed effects:
Estimate Std. Error t value(Intercept)
10.14209
0.57517 17.633
support.gcen-0.27001
0.16277 -1.659
rooms
0.07732
0.15676
0.493
futoukou
1.083420.14731
7.355
support.gcen:rooms
0.082110.04843
1.695
support.gcen:futoukou 0.06234
0.04676
1.333
426# 固定効果名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Correlation of Fixed Effects:(Intr) spprt. rooms futouk spprt.gcn:r
support.gcn 0.082
rooms-0.649 -0.053
futoukou-0.218 -0.018 -0.507
spprt.gcn:r -0.049 -0.661 0.075 -0.038
spprt.gcn:f -0.016 -0.130 -0.037 0.073 -0.567>>> # モデルの適合度の比較> anova(result.lmer0, result.lmer1, result.lmer2, result.lmer3, result.lmer4)
refitting model(s) with ML (instead of REML)
Data: d3
Models:result.lmer0: kenkou ~ support.gcen + rooms + futoukou + (1 | school)
result.lmer1: kenkou ~ support.gcen + rooms + futoukou + (1 | school) + (0 + support.gcen | school)
result.lmer2: kenkou ~ support.gcen + rooms + futoukou + (1 + support.gcen | school)
result.lmer3: kenkou ~ support.gcen + rooms + futoukou + (support.gcen * rooms) + (support.gcen * fut
oukou) + (1 | school) + (0 + support.gcen | school)
result.lmer4: kenkou ~ support.gcen + rooms + futoukou + (support.gcen * rooms) + (support.gcen * fut
oukou) + (1 + support.gcen | school)npar
AIC
BIC logLik deviance Chisq Df Pr(>Chisq)
result.lmer0
6 1630.6 1653.2 -809.28
1618.6
result.lmer1
7 1626.7 1653.1 -806.34
1612.7 5.8875 1
0.015249 *result.lmer2
8 1628.5 1658.6 -806.23
1612.5 0.2165 1
0.641720
result.lmer3
9 1621.6 1655.5 -801.81
1603.6 8.8495 1
0.002932 **result.lmer4
10 1623.6 1661.2 -801.78
1603.6 0.0425 1
0.836646--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
>

427

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

階層線形モデル ― lme関数
nlmeパッケージの読み込み
library(nlme)
ランダム切片モデル
オブジェクト名1 <- lme(基準変数 ~ 固定効果説明変数,
random = ~ 1 | 群分け変数, data=データフレーム名)
summary(オブジェクト名1)
ランダム切片・ランダムスロープモデル
オブジェクト名2 <- lme(基準変数 ~ 固定効果説明変数,
random = ~ 1+レベル1の説明変数 | 群分け変数, data=データフレーム名)
summary(オブジェクト名2)あらかじめnlmeパッケージをインストールしておく必要がある．
「1 | 群分け変数」で，ランダム切片の変量効果変数を表す．
「1+レベル1の説明変数 | 群分け変数」で，ランダム切片・ランダムスロープの変量効果変数を表す．
ランダム切片・ランダムスロープモデルの「1+」は省略してもよい．
【注意】：lmeを用いた場合は，固定効果の異なるモデル間の適合度の比較ができない．
切片とスロープの相関の推定はlmerよりはうまくいく．

> setwd("d:\\")>> # レベル1のデータの読み込み> d1 <- read.table("階層線形モデル_データ1.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
1
2
3
4
5
6
>

id school support kenkou
1
a
5
8
2
a
10
7
3
a
14
8
4
a
11
8
5
a
14
7
6
a
10
6

> # 記述統計量> library(psych)> describeBy(d1[,c("support","kenkou")], d1[,c("school")], mat=TRUE, digits=2)
item group1 vars n mean
sd median trimmed mad min max range skew kurtosis
sesupport1
1a
1 40 9.70 3.23
10.0
9.84 4.45
1 14
13 -0.40-0.63 0.51
support22b
1 40 9.28 3.34
9.0
9.28 2.97
2 16
14 0.00-0.67 0.53
support33c
1 40 11.15 2.63
11.0
11.41 2.97
4 15
11 -0.74
0.06 0.42
support44d
1 40 10.68 2.84
10.5
10.66 3.71
5 17
12 0.08-0.88 0.45
support55e
1 40 10.28 2.63
10.0
10.22 2.97
5 17
12 0.28-0.31 0.42
support6
6f
1 40 10.50 3.35
10.5
10.38 2.97
4 18
14 0.39-0.22 0.53
support7
7g
1 40 9.80 2.36
10.0
9.97 2.97
3 14
11 -0.68
0.16 0.37
support88h
1 40 9.20 2.15
9.0
9.31 1.48
3 13
10 -0.57
0.36 0.34
kenkou19a
2 40 9.38 3.07
9.0
9.19 2.97
3 18
15 0.56
0.06 0.49
kenkou210b
2 40 11.43 3.13
12.0
11.38 2.97
5 19
14 0.05-0.35 0.49
kenkou311c
2 40 13.05 3.01
12.5
12.94 2.97
7 20
13 0.34-0.41 0.48
kenkou412d
2 40 13.22 3.32
13.0
13.28 2.97
7 20
13 -0.18-0.60 0.52
kenkou513e
2 40 13.75 3.43
14.0
14.03 2.97
4 21
17 -0.71
0.74 0.54
kenkou614f
2 40 15.43 3.03
15.0
15.50 2.97
8 21
13 -0.26-0.45 0.48
kenkou715
g
2 40 15.75 3.05
16.0
15.72 2.97 10 22
12 0.02-0.93 0.48
kenkou816h
2 40 16.38 2.39
16.0
16.25 2.97 12 22
10 0.43-0.38 0.38>

428

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 各群の相関係数行列> by(d1[,c("support","kenkou")], d1$school, cor)
d1$school: asupportkenkousupport 1.0000000 -0.1151671
kenkou -0.1151671 1.0000000--------------------------------------------------------d1$school: b
supportkenkousupport 1.0000000 -0.1072993
kenkou -0.1072993 1.0000000--------------------------------------------------------d1$school: csupportkenkousupport 1.0000000 -0.1370703
kenkou -0.1370703 1.0000000--------------------------------------------------------d1$school: dsupportkenkousupport 1.0000000 0.4814743
kenkou 0.4814743 1.0000000--------------------------------------------------------d1$school: esupportkenkousupport 1.0000000 0.2888883
kenkou 0.2888883 1.0000000--------------------------------------------------------d1$school: f
supportkenkousupport 1.0000000 0.2690342
kenkou 0.2690342 1.0000000--------------------------------------------------------d1$school: g
supportkenkousupport 1.0000000 0.3672454
kenkou 0.3672454 1.0000000--------------------------------------------------------d1$school: hsupportkenkousupport 1.0000000 0.4632841
kenkou 0.4632841 1.0000000>> # 群ごとに，説明変数を平均偏差データ化> d1$support.gmean <- ave(d1$support, d1$school)> d1$support.gcen <- d1$support - d1$support.gmean> head(d1)
1
2
3
4
5
6
>

id school support kenkou support.gmean support.gcen
1
a
5
8
9.7
-4.7
2
a
10
7
9.7
0.3
3
a
14
8
9.7
4.3
4
a
11
8
9.7
1.3
5
a
14
7
9.7
4.3
6
a
10
6
9.7
0.3

429

# レベル1のデータに群平均の列を追加# 個人データから群平均を引いた変数の作成

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # レベル2のデータの読み込み> d2 <- read.table("階層線形モデル_データ2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")
> d2
1
2
3
4
5
6
7
8
>

school rooms futoukou
a
3
0
b
1
1
c
2
2
d
5
2
e
4
3
f
5
4
g
7
5
h
3
6

> # レベル2データの情報をレベル1データに反映したデータの作成> d3 <- merge(d1,d2, by="school")#「by」で指定した変数をキーとして，レベル2のデータを追加> d3 <- d3[order(d3$id),]> head(d3)
1
2
3
4
5
6
>

school id support kenkou support.gmean support.gcen rooms futoukou
a 1
5
8
9.7
-4.7
3
0
a 2
10
7
9.7
0.3
3
0
a 3
14
8
9.7
4.3
3
0
a 4
11
8
9.7
1.3
3
0
a 5
14
7
9.7
4.3
3
0
a 6
10
6
9.7
0.3
3
0

> # lme関数を使う方法> #nlmeパッケージの読み込み> library(nlme)>

430

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # ランダム切片モデル> result.lme0 <- lme(kenkou ~ support.gcen + rooms + futoukou,+
random =~ 1 | school,+
data=d3)> summary(result.lme0)
Linear mixed-effects model fit by REML
Data: d3
AIC
BIC
logLik1640.27 1662.804 -814.135
Random effects:
Formula: ~1 | school(Intercept) Residual
StdDev:0.4859375 3.030316# ランダム切片（u0）の標準偏差Fixed effects: kenkou ~ support.gcen + rooms + futoukou
Value Std.Error DF
t-value p-value(Intercept) 10.142085 0.5751724 311 17.633121 0.0000
support.gcen 0.178211 0.0602575 311 2.957489 0.0033
rooms
0.077324 0.1567559
5 0.493277 0.6427
futoukou
1.083417 0.1473102
5 7.354662 0.0007
Correlation:(Intr) spprt. rooms
support.gcen 0.000
rooms-0.649 0.000
futoukou-0.218 0.000 -0.507
Standardized Within-Group Residuals:
Min
Q1
Med
-2.981065892 -0.689897574 0.001932531

Q3
0.732537139

Number of Observations: 320
Number of Groups: 8431# 固定効果Max
2.947451891

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # ランダム切片・ランダムスロープモデル 1> result.lme1 <- lme(kenkou ~ support.gcen + rooms + futoukou,+
random =~ 1+support.gcen | school,+
data=d3)> summary(result.lme1)
Linear mixed-effects model fit by REML
Data: d3
AIC
BIC
logLik1637.177 1667.223 -810.5884
Random effects:
Formula: ~1 + support.gcen | school
Structure: General positive-definite, Log-Cholesky parametrization
StdDev
Corr(Intercept) 0.5097907 (Intr)# ランダム切片（u0）の標準偏差
support.gcen 0.2462596 0.366# ランダムスロープ（u1）の標準偏差Residual
2.9585450# ランダム誤差（e） の標準偏差Fixed effects: kenkou ~ support.gcen + rooms + futoukou
Value Std.Error DF
t-value p-value(Intercept) 10.389482 0.5712641 311 18.186827 0.0000
support.gcen 0.207970 0.1061179 311 1.959798 0.0509
rooms
0.036003 0.1551850
5 0.231998 0.8257
futoukou
1.051264 0.1459317
5 7.203805 0.0008
Correlation:(Intr) spprt. rooms
support.gcen 0.104
rooms-0.645 0.003
futoukou-0.217 -0.016 -0.508
Standardized Within-Group Residuals:
Min
Q1
Med
Q3
-3.14590341 -0.65637835 0.01818610 0.67811975# 固定効果Max
2.69669315

Number of Observations: 320
Number of Groups: 8>> # ランダム切片・ランダムスロープモデル 2> result.lme2 <- lme(kenkou ~ support.gcen + rooms + futoukou++ (support.gcen * rooms) + (support.gcen * futoukou),+random = ~1+support.gcen | school,+
data=d3)> summary(result.lme2)
Linear mixed-effects model fit by REML
Data: d3
AIC
BIC
logLik1642.548 1680.042 -811.2742
Random effects:
Formula: ~1 + support.gcen | school
Structure: General positive-definite, Log-Cholesky parametrization
StdDev
Corr(Intercept) 0.4968951 (Intr)# ランダム切片（u0）の標準偏差
support.gcen 0.1066797 0.203# ランダムスロープ（u1）の標準偏差Residual
2.9583731# ランダム誤差（e） の標準偏差# 固定効果Fixed effects: kenkou ~ support.gcen + rooms + futoukou + (support.gcen * rooms) +(support.
gcen * futoukou)
Value Std.Error DF
t-value p-value(Intercept)
10.142085 0.5751714 309 17.633152 0.0000
support.gcen-0.270004 0.1627717 309 -1.658792 0.0982
rooms
0.077324 0.1567556
5 0.493278 0.6427
futoukou
1.083417 0.1473100
5 7.354675 0.0007
support.gcen:rooms
0.082114 0.0484339 309 1.695392 0.0910
support.gcen:futoukou 0.062341 0.0467619 309 1.333158 0.1835
432

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Correlation:(Intr) spprt. rooms futouk spprt.gcn:r
support.gcen
0.082
rooms
-0.649 -0.053
futoukou-0.218 -0.018 -0.507
support.gcen:rooms-0.049 -0.661 0.075 -0.038
support.gcen:futoukou -0.016 -0.130 -0.037 0.073 -0.567
Standardized Within-Group Residuals:
Min
Q1
Med
Q3
-3.11835666 -0.65749189 0.02274071 0.69469014

Max
2.67482674

Number of Observations: 320
Number of Groups: 8>> # モデルの適合度の比較> anova(result.lme0, result.lme1)
Model df
AIC
BIC
logLikTest L.Ratio p-value
result.lme0
1 6 1640.270 1662.804 -814.1350
result.lme1
2 8 1637.177 1667.223 -810.5884 1 vs 2 7.093129 0.0288
>
>

433

名古屋 大学
検定力分析

大 学院 教育発 達科 学研 究科・ 教育 学部― ２群の平均値

pwr パッケージの読み込み
library("pwr")
あらかじめ pwr パッケージをインストールしておく必要がある。

検定力の計算対応のある2群の平均値
pwr.t.test(d=効果量, n=標本サイズ, type="paired", sig.level=有意水準, alternative="two.sided")
対応のない2群の平均値
pwr.t2n.test(d=効果量, n1=標本サイズ1, n2=標本サイズ2, sig.level=有意水準, alternative="two.sided")

標本サイズの推定
対応のある2群の平均値 （1群あたりの標本サイズ）
pwr.t.test(d=効果量, type="paired", sig.level=有意水準, power=検定力, alternative="two.sided")
対応のない2群の平均値 （1群あたりの標本サイズ）
pwr.t.test(d=効果量, type="two.sample", sig.level=有意水準, power=検定力, alternative="two.sided")

標本サイズと検定力の図
ptt <- pwr.t.test(d=効果量, type="two.sample", sig.level=有意水準, power=検定力, alternative="two.sided")plot(ptt)

参考目安
効果量（d）

小：0.2

中：0.5

大：0.8

> rm(list=ls())>> # pwr パッケージの読み込み> library("pwr")>>>> # 検定力の計算>> # 対応のある2群の平均値> pwr.t.test(d=0.24, n=100, type="paired", sig.level=0.05, alternative="two.sided")
Paired t test power calculationn = 100
d = 0.24
sig.level = 0.05
power = 0.6615591
alternative = two.sided
NOTE: n is number of *pairs*434名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 対応のない2群の平均値> pwr.t2n.test(d=0.24, n1=100, n2=80, sig.level=0.05, alternative="two.sided")t test power calculation
n1 = 100n2 = 80d = 0.24
sig.level = 0.05
power = 0.3564065
alternative = two.sided> # 標本サイズの推定>> # 対応のある2群の平均値 （1群あたりの標本サイズ）> pwr.t.test(d=0.5, type="paired", sig.level=0.05, power=0.8, alternative="two.sided")
Paired t test power calculationn = 33.36713
d = 0.5
sig.level = 0.05
power = 0.8
alternative = two.sided# n=34

NOTE: n is number of *pairs*> # 対応のない2群の平均値 （1群あたりの標本サイズ）> pwr.t.test(d=0.5, type="two.sample", sig.level=0.05,

power=0.8, alternative="two.sided")Two-sample t test power calculationn = 63.76561
d = 0.5
sig.level = 0.05
power = 0.8
alternative = two.sided# 1群あたり n=64

NOTE: n is number in *each* group> # 標本サイズと検定力の図> ptt <- pwr.t.test(d=0.5, type="two.sample", sig.level=0.05, power=0.8, alternative="two.sided")> plot(ptt)435名古屋 大学
検定力分析

大 学院 教育発 達科 学研 究科・ 教育 学部― 相関係数pwr パッケージの読み込み
library("pwr")
あらかじめ pwr パッケージをインストールしておく必要がある。

検定力の計算pwr.r.test(r=相関係数, n=標本サイズ, sig.level=有意水準, alternative="two.sided")

標本サイズの推定
pwr.r.test(r=相関係数, sig.level=有意水準, power=検定力, alternative="two.sided")

標本サイズと検定力の図
prt <- pwr.r.test(r=相関係数, sig.level=有意水準, power=検定力, alternative="two.sided")plot(prt)

参考目安
効果量（r）

小：0.1

中：0.3

大：0.5

> rm(list=ls())>> # pwr パッケージの読み込み> library("pwr")>>> # 検定力の計算> pwr.r.test(r=0.15, n=200, sig.level=0.05, alternative="two.sided")approximate correlation power calculation (arctangh transformation)n = 200
r = 0.15
sig.level = 0.05
power = 0.5659427
alternative = two.sided>>>> # 標本サイズの推定> pwr.r.test(r=0.3, sig.level=0.05, power=0.80, alternative="two.sided")approximate correlation power calculation (arctangh transformation)n = 84.07364
r = 0.3
sig.level = 0.05
power = 0.8
alternative = two.sided# n=85>>>436

名古屋 大学> # 標本サイズと検定力の図> prt <- pwr.r.test(r=0.3, sig.level=0.05,+
power=0.80, alternative="two.sided")> plot(prt)
>
>
>
>

437

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学
検定力分析

大 学院 教育発 達科 学研 究科・ 教育 学部― クロス集計表

pwr パッケージの読み込み
library("pwr")
あらかじめ pwr パッケージをインストールしておく必要がある。

効果量(効果量 <- ES.w2(割合のクロス表))

検定力の計算pwr.chisq.test(w=効果量, df=クロス表の自由度, N=標本サイズ, sig.level=有意水準)

標本サイズの推定
pwr.chisq.test(w=効果量, df=クロス表の自由度, sig.level=有意水準, power=検定力)

標本サイズと検定力の図
pct <- pwr.chisq.test(w=効果量, df=クロス表の自由度, sig.level=有意水準, power=検定力)
plot(pct)参考目安
効果量（連関係数）

小：0.1

中：0.3

大：0.5

> rm(list=ls())> # クロス表> (t1 <- matrix(c(10,20,30, 40,50,60), nrow=2, byrow=TRUE))[,1] [,2] [,3]
[1,]
10
20
30
[2,]
40
50
60
> # 割合> (p1 <- prop.table(t1))
[,1]
[,2]
[,3]
[1,] 0.04761905 0.0952381 0.1428571[2,] 0.19047619 0.2380952 0.2857143>>> # クラメルの連関係数> library(vcd)> assocstats(t1)X^2 df P(> X^2)
Likelihood Ratio 2.9027 2 0.23425
Pearson2.8000 2 0.24660
Phi-Coefficient: NA
Contingency Coeff.: 0.115
Cramer's V: 0.115>>>> # pwr パッケージの読み込み> library("pwr")>
438

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> # 効果量> (esw <- ES.w2(p1))[1] 0.1154701>>> # 標本サイズ> sum(t1)[1] 210> # 検定力の計算> pwr.chisq.test(w=esw, df=2, N=210, sig.level=0.05)
Chi squared power calculation
w = 0.1154701
N = 210
df = 2
sig.level = 0.05
power = 0.3023521
NOTE: N is the number of observations> # 標本サイズの推定> pwr.chisq.test(w=0.3, df=2, sig.level=0.05, power=0.8)
Chi squared power calculation
w = 0.3
N = 107.0521
df = 2
sig.level = 0.05
power = 0.8# n=108

NOTE: N is the number of observations>>>>> # 標本サイズと検定力の図> pct <- pwr.chisq.test(w=0.3, df=2, sig.level=0.05, power=0.8)> plot(pct)
>
>
>
>

439

名古屋 大学
検定力分析

大 学院 教育発 達科 学研 究科・ 教育 学部― ２群の比率pwr パッケージの読み込み
library("pwr")
あらかじめ pwr パッケージをインストールしておく必要がある。

比率p1 <- 比率1
p2 <- 比率2
効果量
効果量 <- ES.h(比率1, 比率2)2*(asin(sqrt(比率1))-asin(sqrt(比率2)))

検定力の計算対応のある2群の比率
pwr.p.test(h=効果量, n=標本サイズ, sig.level=有意水準, alternative="two.sided")
対応のない2群の比率（標本サイズ異なる）
pwr.2p2n.test(h=効果量, n1=標本サイズ1, n2=標本サイズ2, sig.level=有意水準, alternative="two.sided")

標本サイズの推定
p1 <- 比率1
p2 <- 比率2
効果量 <- ES.h(比率1, 比率2)
対応のある2群の比率 （1群あたりの標本サイズ）
pwr.p.test(h=効果量, sig.level=有意水準, power=検定力, alternative="two.sided")
対応のない2群の比率 （1群あたりの標本サイズ）
pwr.2p.test(h=効果量, sig.level=有意水準, power=検定力, alternative="two.sided")

標本サイズと検定力の図
ppt <- pwr.2p.test(h=効果量, sig.level=有意水準, power=検定力, alternative="two.sided")plot(ppt)

参考目安
効果量（h）

小：0.2

中：0.5

大：0.8

> rm(list=ls())> # pwr パッケージの読み込み> library("pwr")>>>>> # 比率> p1 <- 0.5> p2 <- 0.4>
440名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 効果量> (esh <- ES.h(p1, p2))
[1] 0.2013579>> 2*(asin(sqrt(p1))-asin(sqrt(p2)))[1] 0.2013579> # 検定力の計算>> # 対応のある2群の比率> pwr.p.test(h=esh, n=60, sig.level=0.05, alternative="two.sided")proportion power calculation for binomial distribution (arcsine transformation)h = 0.2013579
n = 60sig.level = 0.05
power = 0.3447014
alternative = two.sided> # 対応のない2群の比率（標本サイズ異なる）> pwr.2p2n.test(h=esh, n1=60, n2=80, sig.level=0.05, alternative="two.sided")n)difference of proportion power calculation for binomial distribution (arcsine transformatio
h = 0.2013579
n1 = 60
n2 = 80
sig.level = 0.05
power = 0.2182687
alternative = two.sided
NOTE: different sample sizes> # 標本サイズの推定> p1 <- 0.6> p2 <- 0.35
> esh <- ES.h(p1, p2)>> # 対応のある2群の比率 （1群あたりの標本サイズ）> pwr.p.test(h=esh, sig.level=0.05, power=0.8, alternative="two.sided")proportion power calculation for binomial distribution (arcsine transformation)h = 0.5060506
n = 30.64917
sig.level = 0.05
power = 0.8
alternative = two.sided# n=31> # 対応のない2群の比率 （1群あたりの標本サイズ）> pwr.2p.test(h=esh, sig.level=0.05, power=0.8, alternative="two.sided")
Difference of proportion power calculation for binomial distribution (arcsine transformation)h = 0.5060506
n = 61.29835
sig.level = 0.05
power = 0.8
alternative = two.sided# 1群あたり，n=62

NOTE: same sample sizes
441

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 標本サイズと検定力の図> ppt <- pwr.2p.test(h=esh, sig.level=0.05, power=0.8, alternative="two.sided")> plot(ppt)442

名古屋 大学
検定力分析

大 学院 教育発 達科 学研 究科・ 教育 学部― １つの被験者間要因 (１Ｂ)

pwr パッケージの読み込み
library("pwr")
あらかじめ pwr パッケージをインストールしておく必要がある。

設定
分散分析表と効果量の推定を行って，以下の入力エリアの値（自由度，偏η2乗，水準数）を得る。
それらを入力エリアで設定する。

検定力の計算入力エリア Begin ---------------------------------自由度
dfu <- 被験者間要因の自由度
dfv <- 残差の自由度
偏イータ2乗(partial eta square)
peta2 <- 偏η2乗
入力エリア End -----------------------------------f2 統計量(ef2 <- peta2/(1-peta2))
検定力
pwr.f2.test(u=dfu, v=dfv, f2=ef2, sig.level=有意水準)

標本サイズの推定
入力エリア Begin ---------------------------------水準数
nu <- 被験者間要因の水準数
偏イータ2乗(partial eta square)
peta2 <- 偏η2乗
入力エリア End -----------------------------------自由度(dfu <- (nu-1))
f2 統計量(ef2 <- peta2/(1-peta2))
標本サイズ （1群あたりの標本サイズ）(pf2t <- pwr.f2.test(u=dfu, f2=ef2, sig.level=有意水準, power=検定力))(n <- ceiling((pf2t$v + nu))/nu)

参考目安
効果量（η2乗）

小：0.01

中：0.0.06

大：0.14443

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> rm(list=ls())>> setwd("c:\\home\\Rdocuments\\scripts\\")>>>> # パッケージの読み込み> library(DescTools)> library("pwr")>>>> # 1B要因>> d1 <- read.table("1B平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号 group utsu
1
1
40
29
2
2
40
32
3
3
40
22
4
4
40
28
5
5
40
27
6
6
40
20
>
> # 分散分析> d1$group <- as.factor(d1$group)> result.aov <- aov(utsu ~ group, data=d1)> summary(result.aov)
Df Sum Sq Mean Sq F value Pr(>F)
group2
291 145.67
3.392 0.0353 *Residuals
235 10093
42.95--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> # 効果量> (eta2 <- EtaSq(result.aov))eta.sq eta.sq.part
group 0.02805788 0.02805788>>>> # 検定力の計算>> # 入力エリア Begin --------------------------------->> # 自由度> dfu <- 2
> dfv <- 235>> # 偏イータ2乗(partial eta square)> peta2 <- 0.02805788>> # 入力エリア End ----------------------------------->>> # f2 統計量> (ef2 <- peta2/(1-peta2))[1] 0.02886785>> # 検定力> pwr.f2.test(u=dfu, v=dfv, f2=ef2, sig.level=0.05)
Multiple regression power calculationu = 2
v = 235
f2 = 0.02886785
sig.level = 0.05
power = 0.6407604

444

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 標本サイズの推定>> # 入力エリア Begin --------------------------------->> # 水準数> nu <- 3>> # 偏イータ2乗(partial eta square)> peta2 <- 0.06>
> # 入力エリア End ----------------------------------->>> # 自由度> (dfu <- (nu-1))[1] 2>> # f2 統計量> (ef2 <- peta2/(1-peta2))[1] 0.25>> # 標本サイズ （1群あたりの標本サイズ）> (pf2t <- pwr.f2.test(u=dfu, f2=ef2, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 2
v = 150.9791
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling((pf2t$v + nu)/nu))[1] 52># 1群あたり，n=52445

名古屋 大学
検定力分析

大 学院 教育発 達科 学研 究科・ 教育 学部― １つの被験者内要因 (１Ｗ)

pwr パッケージの読み込み
library("pwr")
あらかじめ pwr パッケージをインストールしておく必要がある。

設定
分散分析表と効果量の推定を行って，以下の入力エリアの値（自由度，偏η2乗，水準数）を得る。
それらを入力エリアで設定する。

検定力の計算入力エリア Begin ---------------------------------自由度
dfu <- 被験者内要因の自由度
dfv <- 残差の自由度
偏イータ2乗(partial eta square)
peta2 <- 偏η2乗
入力エリア End -----------------------------------f2 統計量(ef2 <- peta2/(1-peta2))
検定力
pwr.f2.test(u=dfu, v=dfv, f2=ef2, sig.level=有意水準)

標本サイズの推定
入力エリア Begin ---------------------------------水準数
nu <- 被験者内要因の水準数
偏イータ2乗(partial eta square)
peta2 <- 偏η2乗
入力エリア End -----------------------------------自由度(dfu <- (nu-1))
f2 統計量(ef2 <- peta2/(1-peta2))
標本サイズ （1群あたりの標本サイズ）(pf2t <- pwr.f2.test(u=dfu, f2=ef2, sig.level=有意水準, power=検定力))(n <- ceiling(pf2t$v/dfu + 1))

参考目安
効果量（η2乗）

小：0.01

中：0.0.06

大：0.14446

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> rm(list=ls())>> setwd("c:\\home\\Rdocuments\\scripts\\")>>>> # パッケージの読み込み> library(DescTools)> library("pwr")>>>>> # 1W要因>> d1 <- read.table("1W平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)Team Rank Cooperate
1
13
15
14
2
15
15
10
3
11
13
13
4
14
14
18
5
15
10
14
6
11
11
14
>
> #stackデータの作成> dtmp <- d1> d3 <- stack(dtmp)> did <- c(1:nrow(dtmp))> d4 <- data.frame(d3, did)> colnames(d4) <- c("y", "x", "id")> d4$x <- as.factor(d4$x)> d4$id <- as.factor(d4$id)> head(d4)yx id
1 13 Team 1
2 15 Team 2
3 11 Team 3
4 14 Team 4
5 15 Team 5
6 11 Team 6>> #分散分析> result.aov <- aov(y ~ x + id, data=d4)> summary(result.aov)
Df Sum Sq Mean Sq F value
Pr(>F)
x
2 124.1
62.05 30.229 9.05e-13 ***id
163 595.1
3.65
1.778 6.35e-06 ***Residuals
326 669.2
2.05--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> # 効果量> (eta2 <- EtaSq(result.aov))eta.sq eta.sq.part
x 0.08939073
0.1564409
id 0.42859736
0.4706710>>> # 検定力の計算>> # 入力エリア Begin --------------------------------->> # 自由度> dfu <- 2
> dfv <- 326>> # 偏イータ2乗(partial eta square)> peta2 <- 0.1564409>> # 入力エリア End -----------------------------------447

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # f2 統計量> (ef2 <- peta2/(1-peta2))[1] 0.1854534>> # 検定力> pwr.f2.test(u=dfu, v=dfv, f2=ef2, sig.level=0.05)
Multiple regression power calculationu = 2
v = 326
f2 = 0.1854534
sig.level = 0.05
power = 1>>>>
> # 標本サイズの推定>> # 入力エリア Begin --------------------------------->> # 水準数> nu <- 3>> # 偏イータ2乗(partial eta square)> peta2 <- 0.06>
> # 入力エリア End ----------------------------------->>> # 自由度> (dfu <- (nu-1))[1] 2>> # f2 統計量> (ef2 <- peta2/(1-peta2))[1] 0.25>> # 標本サイズ （1群あたりの標本サイズ）> (pf2t <- pwr.f2.test(u=dfu, f2=ef2, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 2
v = 150.9791
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling(pf2t$v/dfu + 1))[1] 77>># n=77448

名古屋 大学
検定力分析

大 学院 教育発 達科 学研 究科・ 教育 学部― ２つの被験者間要因 (２Ｂ)

pwr パッケージの読み込み
library("pwr")
あらかじめ pwr パッケージをインストールしておく必要がある。

設定
分散分析表と効果量の推定を行って，以下の入力エリアの値（自由度，偏η2乗，水準数）を得る。
それらを入力エリアで設定する。

検定力の計算入力エリア Begin ---------------------------------自由度
dfuB1 <- 被験者間要因1の自由度
dfuB2 <- 被験者間要因2の自由度
dfuB1B2 <- 交互作用の自由度
dfv <- 残差の自由度
偏イータ2乗(partial eta square)
peta2B1 <- 被験者間要因1の偏η2乗
peta2B2 <- 被験者間要因2の偏η2乗
peta2B1B2 <- 交互作用の偏η2乗
入力エリア End -----------------------------------f2 統計量(ef2B1 <- peta2B1/(1-peta2B1))(ef2B2 <- peta2B2/(1-peta2B2))(ef2B1B2 <- peta2B1B2/(1-peta2B1B2))
検定力
pwr.f2.test(u=dfuB1, v=dfv, f2=ef2B1, sig.level=有意水準)
pwr.f2.test(u=dfuB2, v=dfv, f2=ef2B2, sig.level=有意水準)
pwr.f2.test(u=dfuB1B2, v=dfv, f2=ef2B1B2, sig.level=有意水準)

標本サイズの推定
入力エリア Begin ---------------------------------水準数
nuB1 <- 被験者間要因1の水準数
nuB2 <- 被験者間要因2の水準数
偏イータ2乗(partial eta square)
peta2B1 <- 被験者間要因1の偏η2乗
peta2B2 <- 被験者間要因2の偏η2乗
peta2B1B2 <- 交互作用の偏η2乗
入力エリア End -----------------------------------自由度(dfuB1 <- (nuA-1))(dfuB2 <- (nuB-1))(dfuB1B2 <- dfuB1 * dfuB2)
f2 統計量(ef2B1 <- peta2B1/(1-peta2B1))(ef2B2 <- peta2B2/(1-peta2B2))(ef2B1B2 <- peta2B1B2/(1-peta2B1B2))449

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

標本サイズ （1群あたりの標本サイズ）(pf2t <- pwr.f2.test(u=dfuB1, f2=ef2B1, sig.level=有意水準, power=検定力))(n <- ceiling((pf2t$v + nuB1*nuB2)/(nuB1*nuB2)))(pf2t <- pwr.f2.test(u=dfuB2, f2=ef2B2, sig.level=有意水準, power=検定力))(n <- ceiling((pf2t$v + nuB1*nuB2)/(nuB1*nuB2)))(pf2t <- pwr.f2.test(u=dfuB1B2, f2=ef2B1B2, sig.level=有意水準, power=検定力))(n <- ceiling((pf2t$v + nuB1*nuB2)/(nuB1*nuB2)))

参考目安
効果量（η2乗）

小：0.01

中：0.0.06

大：0.14> rm(list=ls())>> setwd("c:\\home\\Rdocuments\\scripts\\")>>>> # パッケージの読み込み> library(DescTools)> library("pwr")>>>> # 2B要因>> d1 <- read.table("2B平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> # 独立変数をfactor型に変換> d1$id <- factor(d1$id)> d1$work <- factor(d1$work, levels=c("many","few"), labels=c("Many", "Few"))> d1$future <- factor(d1$future, levels=c("shingaku","shushoku","mitei"),+labels=c("Shingaku", "Shushoku","Mitei"))> head(d1)
id work
future tekiou
1 1 Few Shingaku
17
2 2 Few Shingaku
13
3 3 Few Shingaku
12
4 4 Few Shingaku
14
5 5 Few Shushoku
10
6 6 Few Shushoku
12>> # 分散分析> mod.1 <- lm(tekiou~work*future, data=d1)> result.aov <- aov(mod.1)> summary(result.aov)
Df Sum Sq Mean Sq F value
Pr(>F)
work
1
1.0
1.02
0.269 0.60448
future2 213.6 106.81 28.294 1.16e-11 ***work:future
2
38.1
19.04
5.043 0.00722 **Residuals
220 830.5
3.78--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>

450

名古屋 大学> # 効果量> (eta2 <- EtaSq(result.aov))eta.sq eta.sq.part
work
0.0003938638 0.0005134451
future0.1972081460 0.2045909323
work:future 0.0351479090 0.0438332936>>>> # 検定力の計算>> # 入力エリア Begin --------------------------------->> # 自由度> dfuB1 <- 1
> dfuB2 <- 2
> dfuB1B2 <- 2
> dfv <- 220>> # 偏イータ2乗(partial eta square)> peta2B1 <- 0.0005134451> peta2B2 <- 0.2045909323> peta2B1B2 <- 0.0438332936>> # 入力エリア End ----------------------------------->>> # f2 統計量> (ef2B1 <- peta2B1/(1-peta2B1))[1] 0.0005137089> (ef2B2 <- peta2B2/(1-peta2B2))[1] 0.2572147> (ef2B1B2 <- peta2B1B2/(1-peta2B1B2))[1] 0.04584273>>> # 検定力> pwr.f2.test(u=dfuB1, v=dfv, f2=ef2B1, sig.level=0.05)
Multiple regression power calculationu = 1
v = 220
f2 = 0.0005137089
sig.level = 0.05
power = 0.0630488> pwr.f2.test(u=dfuB2, v=dfv, f2=ef2B2, sig.level=0.05)
Multiple regression power calculationu = 2
v = 220
f2 = 0.2572147
sig.level = 0.05
power = 0.9999999> pwr.f2.test(u=dfuB1B2, v=dfv, f2=ef2B1B2, sig.level=0.05)
Multiple regression power calculationu = 2
v = 220
f2 = 0.04584273
sig.level = 0.05
power = 0.8188361

451

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 標本サイズの推定>> # 入力エリア Begin --------------------------------->> # 水準数> nuB1 <- 2
> nuB2 <- 3>
> # 偏イータ2乗(partial eta square)> peta2B1 <- 0.06
> peta2B2 <- 0.06
> peta2B1B2 <- 0.06>
> # 入力エリア End ----------------------------------->> # 自由度> (dfuB1 <- (nuA-1))[1] 1> (dfuB2 <- (nuB-1))[1] 1> (dfuB1B2 <- dfuB1 * dfuB2)[1] 1>> # f2 統計量> (ef2B1 <- peta2B1/(1-peta2B1))[1] 0.06382979> (ef2B2 <- peta2B2/(1-peta2B2))[1] 0.06382979> (ef2B1B2 <- peta2B1B2/(1-peta2B1B2))[1] 0.06382979>>> # 標本サイズ （1群あたりの標本サイズ）> (pf2t <- pwr.f2.test(u=dfuB1, f2=ef2B1, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 1
v = 122.9155
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling((pf2t$v + nuB1*nuB2)/(nuB1*nuB2)))[1] 22>> (pf2t <- pwr.f2.test(u=dfuB2, f2=ef2B2, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 1
v = 122.9155
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling((pf2t$v + nuB1*nuB2)/(nuB1*nuB2)))[1] 22>> (pf2t <- pwr.f2.test(u=dfuB1B2, f2=ef2B1B2, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 1
v = 122.9155
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling((pf2t$v + nuB1*nuB2)/(nuB1*nuB2)))[1] 22# 1群あたり，n=22452

名古屋 大学
検定力分析

大 学院 教育発 達科 学研 究科・ 教育 学部― １つの被験者間要因と１つの被験者内要因 (１Ｂ１Ｗ)

pwr パッケージの読み込み
library("pwr")
あらかじめ pwr パッケージをインストールしておく必要がある。

設定
分散分析表と効果量の推定を行って，以下の入力エリアの値（自由度，偏η2乗，水準数）を得る。
それらを入力エリアで設定する。

検定力の計算入力エリア Begin ---------------------------------自由度
dfuB <- 被験者間要因の自由度
dfvB <- 被験者間要因の残差の自由度
dfuW <- 被験者内要因の自由度
dfuBW <- 交互作用の自由度
dfvW <- 被験者内要因の残差の自由度
偏イータ2乗(partial eta square)
peta2B <- 被験者間要因の偏η2乗
peta2W <- 被験者内要因の偏η2乗
peta2BW <- 交互作用の偏η2乗
入力エリア End -----------------------------------f2 統計量(ef2B <- peta2B/(1-peta2B))(ef2W <- peta2W/(1-peta2W))(ef2BW <- peta2BW/(1-peta2BW))
検定力
pwr.f2.test(u=dfuB, v=dfvB, f2=ef2B, sig.level=有意水準)
pwr.f2.test(u=dfuW, v=dfvW, f2=ef2W, sig.level=有意水準)
pwr.f2.test(u=dfuBW, v=dfvW, f2=ef2BW, sig.level=有意水準)

標本サイズの推定
入力エリア Begin ---------------------------------水準数
nuB <- 被験者間要因の水準数
nuW <- 被験者内要因の水準数
偏イータ2乗(partial eta square)
peta2B <- 被験者間要因の偏η2乗
peta2W <- 被験者内要因の偏η2乗
peta2BW <- 交互作用の偏η2乗
入力エリア End ------------------------------------

453

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

自由度(dfuB <- (nuB-1))(dfuW <- (nuW-1))(dfuBW <- dfuB * dfuW)
f2 統計量(ef2B <- peta2B/(1-peta2B))(ef2W <- peta2W/(1-peta2W))(ef2BW <- peta2BW/(1-peta2BW))
標本サイズ （1群あたりの標本サイズ）(pf2t <- pwr.f2.test(u=dfuB, f2=ef2B, sig.level=有意水準, power=検定力))(n <- ceiling((pf2t$v + nuB)/nuB))(pf2t <- pwr.f2.test(u=dfuW, f2=ef2W, sig.level=有意水準, power=検定力))(n <- ceiling((pf2t$v/dfuW + nuB)/nuB))(pf2t <- pwr.f2.test(u=dfuBW, f2=ef2BW, sig.level=有意水準, power=検定力))(n <- ceiling((pf2t$v/dfuW + nuB)/nuB))

参考目安
効果量（η2乗）

小：0.01

中：0.0.06

大：0.14> rm(list=ls())>> setwd("c:\\home\\Rdocuments\\scripts\\")>>>> # パッケージの読み込み> library(DescTools)> library("pwr")
>
>
>
>
>
> # 1B1W要因>> d1 <- read.table("1B1W平均値データ_3時点.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>> # stackデータの作成> d2 <- d1[,c("mh1","mh2","mh3")]> d3 <- stack(d2)> d4 <- data.frame(d1$id, d1$group, d3)> colnames(d4) <- c("id", "group", "y","x")> head(d4)idgroup yx
1 1 experiment 11 mh1
2 2 experiment 18 mh1
3 3 experiment 9 mh1
4 4 experiment 17 mh1
5 5 experiment 9 mh1
6 6 experiment 12 mh1>
454

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 独立変数をfactor型に変換> d4$id <- factor(d4$id)> d4$group <- factor(d4$group)> d4$x <- factor(d4$x)>>>>> # 分散分析> result.aov <- aov(y ~ group * x + Error(id + id:group + id:group:x), data=d4)
警告メッセージ:
aov(y ~ group * x + Error(id + id:group + id:group:x), data = d4) で:Error() モデルは特異です> summary(result.aov)Error: id

Df Sum Sq Mean Sq F value
Pr(>F)
group
1 144.7 144.74
25.82 1.87e-06 ***Residuals 95 532.6
5.61--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:group:x
Df Sum Sq Mean Sq F value
Pr(>F)
x
2 307.9 153.93
36.83 3.03e-14 ***group:x
2 123.4
61.70
14.76 1.10e-06 ***Residuals 190 794.1
4.18--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> # 効果量> (eta2 <- EtaSq(result.aov, type=1))
eta.sq eta.sq.part eta.sq.gen
group0.07607493
0.2137043 0.09837276
x0.16180455
0.2793801 0.18835006
group:x 0.06486216
0.1345093 0.08510749>>>> # 検定力の計算>> # 入力エリア Begin --------------------------------->> # 自由度> dfuB <- 1
> dfvB <- 95>> dfuW <- 2
> dfuBW <- 2
> dfvW <- 190>>> # 偏イータ2乗(partial eta square)> peta2B <- 0.2137043> peta2W <- 0.2793801> peta2BW <- 0.1345093>> # 入力エリア End ----------------------------------->>> # f2 統計量> (ef2B <- peta2B/(1-peta2B))[1] 0.2717862> (ef2W <- peta2W/(1-peta2W))[1] 0.3876941> (ef2BW <- peta2BW/(1-peta2BW))[1] 0.1554139>>
455

名古屋 大学> # 検定力> pwr.f2.test(u=dfuB, v=dfvB, f2=ef2B, sig.level=0.05)
Multiple regression power calculationu = 1
v = 95f2 = 0.2717862
sig.level = 0.05
power = 0.999102> pwr.f2.test(u=dfuW, v=dfvW, f2=ef2W, sig.level=0.05)
Multiple regression power calculationu = 2
v = 190f2 = 0.3876941
sig.level = 0.05
power = 1
> pwr.f2.test(u=dfuBW, v=dfvW, f2=ef2BW, sig.level=0.05)
Multiple regression power calculationu = 2
v = 190f2 = 0.1554139
sig.level = 0.05
power = 0.9990991
>
>
>
>
>
> # 標本サイズの推定>> # 入力エリア Begin --------------------------------->> # 水準数> nuB <- 2
> nuW <- 3>
> # 偏イータ2乗(partial eta square)> peta2B <- 0.06
> peta2W <- 0.06
> peta2BW <- 0.06>
> # 入力エリア End ----------------------------------->> # 自由度> (dfuB <- (nuB-1))[1] 1> (dfuW <- (nuW-1))[1] 2> (dfuBW <- dfuB * dfuW)[1] 2>> # f2 統計量> (ef2B <- peta2B/(1-peta2B))[1] 0.06382979> (ef2W <- peta2W/(1-peta2W))[1] 0.06382979> (ef2BW <- peta2BW/(1-peta2BW))[1] 0.06382979
>
>

456

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 標本サイズ （1群あたりの標本サイズ）> (pf2t <- pwr.f2.test(u=dfuB, f2=ef2B, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 1
v = 122.9155
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling((pf2t$v + nuB)/nuB))[1] 63>> (pf2t <- pwr.f2.test(u=dfuW, f2=ef2W, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 2
v = 150.9791
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling((pf2t$v/dfuW + nuB)/nuB))[1] 39>> (pf2t <- pwr.f2.test(u=dfuBW, f2=ef2BW, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 2
v = 150.9791
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling((pf2t$v/dfuW + nuB)/nuB))[1] 39# 1群あたり，n=63457

名古屋 大学
検定力分析

大 学院 教育発 達科 学研 究科・ 教育 学部― ２つの被験者内要因 (２Ｗ)

pwr パッケージの読み込み
library("pwr")
あらかじめ pwr パッケージをインストールしておく必要がある。

設定
分散分析表と効果量の推定を行って，以下の入力エリアの値（自由度，偏η2乗，水準数）を得る。
それらを入力エリアで設定する。

検定力の計算入力エリア Begin ---------------------------------自由度
dfuW1 <- 被験者内要因1の自由度
dfuW2 <- 被験者内要因2の自由度
dfuW1W2 <- 交互作用の自由度
dfvW1 <- 被験者内要因1の残差の自由度
dfvW2 <- 被験者内要因2の残差の自由度
dfvW1W2 <- 交互作用の残差の自由度
偏イータ2乗(partial eta square)
peta2W1 <- 被験者内要因1の偏η2乗
peta2W2 <- 被験者内要因2の偏η2乗
peta2W1W2 <- 交互作用の偏η2乗
入力エリア End -----------------------------------f2 統計量(ef2W1 <- peta2W1/(1-peta2W1))(ef2W2 <- peta2W2/(1-peta2W2))(ef2W1W2 <- peta2W1W2/(1-peta2W1W2))
検定力
pwr.f2.test(u=dfuW1, v=dfv, f2=ef2W1, sig.level=有意水準)
pwr.f2.test(u=dfuW2, v=dfv, f2=ef2W2, sig.level=有意水準)
pwr.f2.test(u=dfuW1W2, v=dfv, f2=ef2W1W2, sig.level=有意水準)

標本サイズの推定
入力エリア Begin ---------------------------------水準数
nuW1 <- 被験者内要因1の水準数
nuW2 <- 被験者内要因2の水準数
偏イータ2乗(partial eta square)
peta2W1 <- 被験者内要因1の偏η2乗
peta2W2 <- 被験者内要因2の偏η2乗
peta2W1W2 <- 交互作用の偏η2乗
入力エリア End ------------------------------------

458

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

自由度(dfuW1 <- (nuW1-1))(dfuW2 <- (nuW2-1))(dfuW1W2 <- dfuW1 * dfuW2)
f2 統計量(ef2W1 <- peta2W1/(1-peta2W1))(ef2W2 <- peta2W2/(1-peta2W2))(ef2W1W2 <- peta2W1W2/(1-peta2W1W2))
標本サイズ （1群あたりの標本サイズ）(pf2t <- pwr.f2.test(u=dfuW1, f2=ef2W1, sig.level=有意水準, power=検定力))(n <- ceiling(pf2t$v/dfuW1 + 1))(pf2t <- pwr.f2.test(u=dfuW2, f2=ef2W2, sig.level=有意水準, power=検定力))(n <- ceiling(pf2t$v/dfuW2 + 1))(pf2t <- pwr.f2.test(u=dfuW1W2, f2=ef2W1W2, sig.level=有意水準, power=検定力))(n <- ceiling(pf2t$v/(dfuW1*dfuW2) + 1))

参考目安
効果量（η2乗）

小：0.01

中：0.0.06

大：0.14> rm(list=ls())>> setwd("c:\\home\\Rdocuments\\scripts\\")>>>> # パッケージの読み込み> library(DescTools)> library("pwr")>>>>> # 2W要因>> d1 <- read.table("2W平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d2 <- d1[-1]> head(d2)cs cd ns nd
1 34 22 36 22
2 36 21 33 17
3 34 25 36 23
4 36 29 32 21
5 36 25 34 21
6 37 23 33 24>> #stackデータの作成> d3 <- stack(d2)> d3$x1 <- substr(d3$ind,1,1)> d3$x2 <- substr(d3$ind,2,2)> d3$id <- d1$id> d4 <- d3[,c("id","values", "x1", "x2")]> colnames(d4) <- c("id","y", "x1", "x2")>> # 独立変数をfactor型に変換> d4$id <- factor(d4$id)> d4$x1 <- factor(d4$x1)> d4$x2 <- factor(d4$x2)
459

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> head(d4)id y x1 x2
1 1 34 c s
2 2 36 c s
3 3 34 c s
4 4 36 c s
5 5 36 c s
6 6 37 c s>>> # 分散分析> result.aov <- aov(y ~ x1 * x2 + Error(id + id:x1 + id:x2 + id:x1:x2), data=d4)> summary(result.aov)Error: id
Df Sum Sq Mean Sq F value Pr(>F)
Residuals 137
1461
10.66
Error: id:x1
Df Sum Sq Mean Sq F value Pr(>F)
x1
1
552
552.0
98.21 <2e-16 ***Residuals 137
770
5.6--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:x2
Df Sum Sq Mean Sq F value Pr(>F)
x2
1 1738717387
3184 <2e-16 ***Residuals 137748
5--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Error: id:x1:x2
Df Sum Sq Mean Sq F value Pr(>F)
x1:x2
1
0.1
0.065
0.014 0.905
Residuals 137 618.9
4.518>> # 効果量> EtaSq(result.aov, type=1)
eta.sq eta.sq.part
eta.sq.gen
x1
2.563036e-02 0.4175491679 1.330144e-01
x2
8.073083e-01 0.9587517931 8.285468e-01
x1:x2 3.028162e-06 0.0001053593 1.812605e-05> # 検定力の計算>> # 入力エリア Begin --------------------------------->> # 自由度> dfuW1 <- 1
> dfuW2 <- 1
> dfuW1W2 <- 1>
> dfvW1 <- 137> dfvW2 <- 137> dfvW1W2 <- 137>> # 偏イータ2乗(partial eta square)> peta2W1 <- 0.4175491679> peta2W2 <- 0.9587517931> peta2W1W2 <- 0.0001053593>> # 入力エリア End ----------------------------------->>

460

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # f2 統計量> (ef2W1 <- peta2W1/(1-peta2W1))[1] 0.7168831> (ef2W2 <- peta2W2/(1-peta2W2))[1] 23.24348> (ef2W1W2 <- peta2W1W2/(1-peta2W1W2))[1] 0.0001053704>>> # 検定力> pwr.f2.test(u=dfuW1, v=dfvW1, f2=ef2W1, sig.level=0.05)
Multiple regression power calculationu = 1
v = 137
f2 = 0.7168831
sig.level = 0.05
power = 1
> pwr.f2.test(u=dfuW2, v=dfvW2, f2=ef2W2, sig.level=0.05)
Multiple regression power calculationu = 1
v = 137
f2 = 23.24348
sig.level = 0.05
power = 1
> pwr.f2.test(u=dfuW1W2, v=dfvW1W2, f2=ef2W1W2, sig.level=0.05)
Multiple regression power calculationu = 1
v = 137
f2 = 0.0001053704
sig.level = 0.05
power = 0.05165605> # 標本サイズの推定>> # 入力エリア Begin --------------------------------->> # 水準数> nuW1 <- 2
> nuW2 <- 2>
> # 偏イータ2乗(partial eta square)> peta2W1 <- 0.06
> peta2W2 <- 0.06
> peta2W1W2 <- 0.06>
> # 入力エリア End ----------------------------------->> # 自由度> (dfuW1 <- (nuW1-1))[1] 1> (dfuW2 <- (nuW2-1))[1] 1> (dfuW1W2 <- dfuW1 * dfuW2)[1] 1>> # f2 統計量> (ef2W1 <- peta2W1/(1-peta2W1))[1] 0.06382979> (ef2W2 <- peta2W2/(1-peta2W2))[1] 0.06382979> (ef2W1W2 <- peta2W1W2/(1-peta2W1W2))[1] 0.06382979
461

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 標本サイズ （1群あたりの標本サイズ）> (pf2t <- pwr.f2.test(u=dfuW1, f2=ef2W1, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 1
v = 122.9155
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling(pf2t$v/dfuW1 + 1))[1] 124>> (pf2t <- pwr.f2.test(u=dfuW2, f2=ef2W2, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 1
v = 122.9155
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling(pf2t$v/dfuW2 + 1))[1] 124>> (pf2t <- pwr.f2.test(u=dfuW1W2, f2=ef2W1W2, sig.level=0.05, power=0.8))
Multiple regression power calculationu = 1
v = 122.9155
f2 = 0.06382979
sig.level = 0.05
power = 0.8> (n <- ceiling(pf2t$v/(dfuW1*dfuW2) + 1))[1] 124# 1群あたり，n=124

462

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

１群の平均値
信頼区間に基づいて，１群の平均値について推測する場合に，最低限必要な標本サイズを推定する．
以下の自作関数を用いる．
# ---------------------------------------------------------------# 標本サイズの推定 １群の平均値
sampleN1m <- function(h=0.5, conf.level=0.95){
a2 <- 1 - (1-conf.level)/2n <- 2
repeat{df <- n-1
t1 <- qt(a2, df)
tn <- t1*t1/(h*h)
if (tn > n) n <- n+1
if (tn <= n) break}nout <- matrix(c(h, conf.level, n),1,3)
colnames(nout) <- c("h", "conf.level","N")
return(data.frame(nout))}# ---------------------------------------------------------------# 標本サイズの推定 １群の平均値# h : 平均値の信頼区間の半幅 (デフォルトは0.5)# conf.level : 信頼係数 (デフォルトは0.95)> sampleN1m(h=0.5, conf.level=0.95)
h conf.level N
1 0.5
0.95 18# 信頼係数が0.95で良ければ，# conf.level=0.95は省略できる> sampleN1m(h=0.5, conf.level=0.90)
h conf.level N
1 0.5
0.9 13463

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

２群の平均値差
信頼区間に基づいて，２群の平均値の差について推測する場合に，最低限必要な標本サイズを推定する．
対応のない場合と，対応のある場合がある
以下の自作関数を用いる．

# ---------------------------------------------------------------# 標本サイズ 対応のない２群の平均値
sampleN2m <- function(h=0.5, conf.level=0.95){
a2 <- 1 - (1-conf.level)/2n <- 2
repeat{df <- 2*(n-1)
t0 <- qt(a2, df)
tn <- 2*t0*t0/(h*h)
if (tn > n) n <- n+1
if (tn <= n) break}nout <- matrix(c(h, conf.level, n),1,3)
colnames(nout) <- c("h", "conf.level","N.per.group")
return(data.frame(nout))}# ---------------------------------------------------------------# 標本サイズ 対応のない２群の平均値# h : 平均値の差の信頼区間の半幅 (デフォルトは0.5)# conf.level : 信頼係数 (デフォルトは0.95)> sampleN2m(h=0.5, conf.level=0.95)
h conf.level N.per.group
1 0.5
0.95
32

# ---------------------------------------------------------------# 標本サイズ 対応のある２群の平均値
sampleN2ma <- function(h=0.5, r=0, conf.level=0.95){
a2 <- 1 - (1-conf.level)/2n <- 2
repeat{df <- n-1
t0 <- qt(a2, df)
tn <- 2*t0*t0*(1-r)/(h*h)
if (tn > n) n <- n+1
if (tn <= n) break}nout <- matrix(c(h, conf.level, n),1,3)
colnames(nout) <- c("h", "conf.level","N")
return(data.frame(nout))}# ---------------------------------------------------------------# 標本サイズ 対応のある２群の平均値# h : 平均値の差の信頼区間の半幅 (デフォルトは0.5)# r ： ２群のデータの相関係数 (デフォルトは0)# conf.level : 信頼係数 (デフォルトは0.95)> sampleN2ma(h=0.5, r=0.3, conf.level=0.95)
h conf.level N
1 0.5
0.95 24464

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

相関係数
信頼区間に基づいて，相関係数，および，対応のない２群の相関係数の差について推測する場合に，最低限必要な標本サイズを推定する．
以下の自作関数を用いる．
# ---------------------------------------------------------------# 標本サイズ 相関係数
sampleN1r <- function(r=0, h=0.1, conf.level=0.95){
a2 <- 1 - (1-conf.level)/2n <- 4
repeat{t0 <- qnorm(a2)se <- 1/sqrt(n-3)
lz <- atanh(r)-t0*se
uz <- atanh(r)+t0*se
elz <- tanh(lz)euz <- tanh(uz)hci <- (euz-elz)/2
if (hci > h) n <- n+1
if (hci <= h) break}nout <- matrix(c(r, h, conf.level, n),1,4)
colnames(nout) <- c("r", "h", "conf.level","N")
return(data.frame(nout))}# ---------------------------------------------------------------# 標本サイズ 相関係数
# r ： 相関係数の推定値 (デフォルトは0)# h : 相関係数の信頼区間の半幅 (デフォルトは0.1)# conf.level : 信頼係数 (デフォルトは0.95)> sampleN1r(r=0.4, h=0.1, conf.level=0.95)
rh conf.levelN
1 0.4 0.1
0.95 273# ---------------------------------------------------------------# 標本サイズ 対応のない２群の相関係数
sampleN2r <- function(dr=0, h=0.1, conf.level=0.95){
a2 <- 1 - (1-conf.level)/2n <- 4
repeat{t0 <- qnorm(a2)se <- sqrt(2/(n-3))
lz <- atanh(dr)-t0*se
uz <- atanh(dr)+t0*se
elz <- tanh(lz)euz <- tanh(uz)hci <- (euz-elz)/2
if (hci > h) n <- n+1
if (hci <= h) break}nout <- matrix(c(dr, h, conf.level, n),1,4)
colnames(nout) <- c("dr", "h", "conf.level","N.per.group")
return(data.frame(nout))}# ---------------------------------------------------------------# 標本サイズ 対応のない２群の相関係数# ｄr ： 相関係数の差の推定値 (デフォルトは0)# h : 相関係数の差の信頼区間の半幅 (デフォルトは0.1)# conf.level : 信頼係数 (デフォルトは0.95)> sampleN2r(dr=0.2, h=0.1, conf.level=0.95)
drh conf.level N.per.group
1 0.2 0.1
0.95
707
465

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

比率の場合
信頼区間に基づいて，１群の比率，および，対応のない２群の比率の差について推測する場合に，最低限必要な標本サイズを推定する．
以下の自作関数を用いる．

# ---------------------------------------------------------------# 標本サイズ １群の比率
sampleN1p <- function(p=0.5, h=0.1, conf.level=0.95){
a2 <- 1 - (1-conf.level)/2n <- 2
repeat{t0 <- qnorm(a2)tn <- t0*t0*p*(1-p)/(h*h)
if (tn > n) n <- n+1
if (tn <= n) break}nout <- matrix(c(p, h, conf.level, n),1,4)
colnames(nout) <- c("p", "h", "conf.level","N")
return(data.frame(nout))}# ---------------------------------------------------------------# 標本サイズ １群の比率# p ： 比率の推定値 (デフォルトは0.5)# h : 比率の信頼区間の半幅 (デフォルトは0.1)# conf.level : 信頼係数 (デフォルトは0.95)> sampleN1p(p=0.4, h=0.1, conf.level=0.95)
ph conf.level N
1 0.4 0.1
0.95 93# ---------------------------------------------------------------# 標本サイズ 対応のない２群の比率
sampleN2p <- function(p1=0.5, p2=0.5, h=0.1, conf.level=0.95){
a2 <- 1 - (1-conf.level)/2n <- 2
repeat{t0 <- qnorm(a2)tn <- t0*t0*(p1*(1-p1)+p2*(1-p2))/(h*h)
if (tn > n) n <- n+1
if (tn <= n) break}nout <- matrix(c(p1, p2, h, conf.level, n),1,5)
colnames(nout) <- c("p1", "p2", "h", "conf.level","N.per.group")
return(data.frame(nout))}# ---------------------------------------------------------------# 標本サイズ 対応のない２群の比率# p1 ： 第１群の比率の推定値 (デフォルトは0.5)# p2 ： 第２群の比率の推定値 (デフォルトは0.5)# h : 比率の差の信頼区間の半幅 (デフォルトは0.1)# conf.level : 信頼係数 (デフォルトは0.95)> sampleN2p(h=0.1, p1=0.1, conf.level=0.95)
p1 p2
h conf.level N.per.group
1 0.1 0.5 0.1
0.95
131

# p2の設定を省略しているので，# デフォルト値0.5が用いられる

466

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

項目分析 － 自作関数
自作スクリプトを使って，多枝選択項目の項目分析を実行する
トレースライン作成にあたっては，群サイズが均等になるように群を構成している．同じ得点でも入る群が異なることがある．
３群の場合は，Kelley=TRUEとすると，下位27%，中位46%，上位27%と受験者を群わけする。
複数選択に対応
1つの項目において，選択枝を正しく選択できたら正答，それ以外は誤答とする。正答選択枝は複数あってもよく，すべて正しく選択できた場合のみ正答とする。解答の順序は逆順になっていてもよい。
解答データファイル
１行に一人の受験者，１列に１つの変数が入力されているcsvファイルとする。
無解答は空白にする。
解答データは,1,2,3のような数値でも，A,B,Cのような記号でも，どちらでも良い．
第１列目は必ず受験番号（ID)とする。
２行目から属性変数を設定する（省略可）。
属性変数の後にテスト項目を設定する。最終テスト項目より右には何も入力しない。
複数の選択枝を選択している場合は，同一セル内に，「,」（半角カンマ）で区切って入力する。
解答データの例

正答キーファイル
１行目に項目名，２行目に正答記号の入ったcsvファイルとする。
第１列は，１行目に「科目」，２行目に科目名を入れておくとよい。
各項目の変数名は，解答データと同一でなければならない。
正答枝が複数ある場合は，同一セル内に，「,」（半角カンマ）で区切って入力する。
正答キーデータの例

スクリプトで設定すべきもの# Data File Name（解答データ）
ansFileName <- "解答データファイル名(.csv)"# Key File name（正答キーデータ）
keyFileName <- "正答キーデータファイル名(.csv)"# Column Number of First Test Item:（テスト項目が始まる列の番号(数字)）
firstItemCol <- 5
# Option Categories（選択枝に用いた記号）
OPTIONS <- c("A","B","C","D")OPTIONS <- c("0","1"【重要】 0/1データを分析するときも，数値ではなく文字として扱う。

467

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部# Number of groups in trace line（トレースラインを描くときの群の数）
NGROUP <- 3
# Following Kelly's percentages（Kelleyの基準を使うか否か）
KELLEY <- TRUE
# Score output file name（0/1採点したデータを保存するファイル名）
scoFileName <- "ScoreData.csv"# Total Score Summary output file name（テスト得点の記述統計量を保存するファイル名）
totFileName <- "TotalSummary.csv"# Item Analysis output file name（全項目の項目分析の結果を保存するファイル名）
itaFileName <- "ItemAnalysis.csv"# Result of Each Item output file name（各項目の詳細な分析結果を保存するファイル名）
reiFileName <- "ResultEachItem.csv"# Trace line output file name（トレースラインの図を保存するPDFファイル名）
trlFileName <- "TraceLine.pdf"

468

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

出力ファイル
以下の５個のファイルを出力
0/1採点した得点データ
テスト得点の記述統計量
全項目の項目分析の結果
各項目の項目分析の詳細な結果
トレースライン
得点データ

各項目：各項目の0/1得点
Total：合計得点
Prop ：合計得点の得点率
テスト合計得点および得点率の記述統計量

Items：項目数
N：受験者数
Mean：平均値
SD：標準偏差
Min：最小値
Med：中央値
Max：最大値
Alpha:アルファ係数
全項目の項目分析の結果

Item：項目名
N：受験者数
P：正答率
D：D値（上位群の正答率 － 下位群の正答率）
Corr：I-T相関係数（項目得点と，合計点から当該項目の得点を引いた得点との相関係数）
Alpha：アルファ係数（テスト全体のアルファ係数なので，全項目に同じ値が入っている）
Dalpha：当該項目を削除したときのアルファ係数
Key：正答キー
o選択枝：当該選択枝の選択率
Missing：無答率469

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

各項目の項目分析の詳細な結果

Item：項目名
Key：正答キー
N：受験者数
P：正答率
D：D値（上位群の正答率 － 下位群の正答率）
Corr：I-T相関係数（項目得点と，合計点から当該項目の得点を引いた得点との相関係数）
Alpha：アルファ係数（テスト全体のアルファ係数なので，全項目に同じ値が入っている）
Dalpha：当該項目を削除したときのアルファ係数
選択率
All：受験者全体
U：上位群
M：中位群
L：下位群
Missing：無答率
識別力
D：当該選択枝のD値（上位群の選択率 － 下位群の選択率）
Corr：当該選択枝のI-T相関家数（当該選択枝の選択の有無と，合計点から当該項目の得点を引いた得点との相関係数）
トレースライン

太線：正答枝細線：誤答枝－：無回答

470

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

関数
設定すべき値を指定して，以下のスクリプト全体を実行する．

# Item Analysis# Memory clear
rm(list=ls())# Set work directory
setwd("d:\\")# Data File Name#ansFileName <- "データサンプル3_解答データ.csv"
ansFileName <- "サンプル解答100(複数選択).csv"# Key File name#keyFileName <- "データサンプル3_正答キー.csv"
keyFileName <- "サンプル正答100(複数選択).csv"# Column Number of First Test Item:
firstItemCol <- 5
# Option Categories
OPTIONS <- c("A","B","C","D")# OPTIONS <- c("0","1")# Number of groups in trace line
NGROUP <- 3
# Following Kelly's percentages
KELLEY <- TRUE

# Score output file namescoFileName <- "ScoreData.csv"# Total Score Summary output file nametotFileName <- "TotalSummary.csv"# Item Analysis output file nameitaFileName <- "ItemAnalysis.csv"# Result of Each Item output file namereiFileName <- "ResultEachItem.csv"# Trace line output file nametrlFileName <- "TraceLine.pdf"#-----------------------------------------------------------# Basically, no change is necessary in the following.
#------------------------------------------------------------# Digits
rdgts <- 2471

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部# ----------------------------------------------------------# Data importdans <- read.table(ansFileName, header=T, sep=",", fileEncoding="shift-jis")dkey <- read.table(keyFileName, header=T, sep=",", fileEncoding="shift-jis")# Number of Items
nItem <- ncol(dans) - firstItemCol + 1# Number of OPTIONS
nOption <- length(OPTIONS)# Sample size
nSample <- nrow(dans)# Item names
itemNames <- colnames(dans)[firstItemCol : ncol(dans)]# ID variable nameidName <- colnames(dans)[1]# Score matrix
score <- as.data.frame(matrix(c(0), nrow=nSample, ncol=nItem ))colnames(score) <- c(itemNames)# Scoringfor(i in itemNames){
dkeytmp <- rep(0, nOption)names(dkeytmp) <- OPTIONS
for(j in OPTIONS){
if (grepl(j,dkey[,i])) dkeytmp[j] <- 1}
dansitmp <- matrix(c(0), nrow=nSample, ncol=nOption)
colnames(dansitmp) <- OPTIONS
for(j in OPTIONS){
dansitmp[,j] <- ifelse(grepl(j, dans[,i]), 1, 0)}score[,i] <- ifelse((apply(dansitmp, 1, paste, collapse="")==paste(dkeytmp, collapse="")), 1, 0)}# Total scoresscore$Total <- rowSums(score[,itemNames])score$Prop <- floor(100 * (rowMeans(score[,itemNames]) +0.005)) / 100# Score Data
dscore <- data.frame(dans[,c(1:(firstItemCol-1))], score)# Output Score data
write.table(dscore, scoFileName, row.names=F, sep=",", fileEncoding="shift-jis")# Total Scores Summary
tot <- prop <- NULL
tot$Score <- "Total"
tot$Items <- length(itemNames)
tot$N <- nSample
tot$Mean <- floor(10^rdgts * (mean(score[,"Total"])+0.005))/10^rdgts
tot$SD <floor(10^rdgts * ( sd(score[,"Total"])+0.005))/10^rdgts
tot$Min <- min(score[,"Total"])
tot$Med <- median(score[,"Total"])
tot$Max <- max(score[,"Total"])
tot$Alpha <- floor(10^rdgts * (length(itemNames)/(length(itemNames)-1) *(1-sum(apply(score[,itemNames],2,var))/var(score[,"Total"]))+0.005)) / 10
^rdgtsprop$Score <- "Prop"
prop$Items <- tot$Items
prop$N <- tot$N
prop$Mean <- floor(10^rdgts * (mean(score[,"Total"])/prop$Items+0.005))/10^rdgts472

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

prop$SD <floor(10^rdgts * ( sd(score[,"Total"])/prop$Items+0.005))/10^rdgts
prop$Min <- min(score[,"Prop"])prop$Med <- median(score[,"Prop"])prop$Max <- max(score[,"Prop"])prop$Alpha <- tot$Alpha
totout <- as.data.frame(tot)propout <- as.data.frame(prop)
tpout <- rbind(totout, propout)# Output Total score summary
write.table(tpout, totFileName, row.names=F, sep=",", fileEncoding="shift-jis")#remove tpout, totout, propout, prop
rm(tpout, totout, propout, prop)# Item analysis
optionNames <- paste("o",OPTIONS, sep="")itaNames <- c("Item", "N", "P", "D", "Corr", "Alpha", "Dalpha", "Key", optionNames, "oNA")
dita <- matrix(c(0), nrow=length(itemNames), ncol=length(itaNames))
Corr <- rep(0, length(itemNames))
names(Corr) <- itemNames
rownames(dita) <- itemNames
colnames(dita) <- itaNames
dita[,"Item"] <- itemNames
dita[,"N"] <- tot$N
dita[,"P"] <- floor(10^rdgts * (colMeans(score[,itemNames])+0.005))/ 10^rdgts
dita[,"Alpha"] <- tot$Alphafor(i in itemNames){
Corr[i] <- cor(score[,i],(score[,"Total"]-score[,i]))dita[i,"Corr"] <- floor(10^rdgts * (Corr[i]+0.005))/ 10^rdgts
scoreDi <- score[, itemNames[(itemNames %in% i)==F]]dita[i,"Dalpha"] <- floor(10^rdgts * (ncol(scoreDi)/(ncol(scoreDi)-1) *(1-sum(apply(scoreDi,2,var))/var(rowSums(scoreDi)))+0.005))/ 10^rdg
ts}
dita[,"Key"] <- as.character(t(dkey[,itemNames]))# Data Sorting
vCorr <- Corr[Corr>0]
sNames <- names(vCorr)[order(vCorr, decreasing=T)]
sNames <- paste(",dscore$",sNames, sep="", collapse=" ")eval(parse(text=paste("dsort <- dscore[order(dscore$Total", sNames, ",dscore[,1]),]",sep="") ))dsort$sortID <- c(1:nrow(dsort))# remove score, scoreDi, dscore, Corrrm(score,scoreDi,dscore, Corr)# Subgroup sizenSub <- ceiling(nSample * 0.27)# Subgroup labeldsort$LMU <- ifelse(dsort[,"sortID"]<=nSub, "L",ifelse((dsort[,"sortID"]>nSub)&(dsort[,"sortID"]<=(nSample-nSub)), "M", "U"))# D index
dsortL <- dsort[dsort$LMU=="L",]dsortU <- dsort[dsort$LMU=="U",]dita[,"D"] <- floor(10^rdgts * (colMeans(dsortU[,itemNames]) colMeans(dsortL[,itemNames])+0.005))/ 10^rdgts# remove dsortU, dsortL
rm(dsortU)
473

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

rm(dsortL)# Each Item
drei <- NULL
v1 <- c("Item", "Key","N", "P", "D", "Corr", "Alpha","DAlpha")for(i in itemNames){# subjects*options matrix per item
dkeytmp <- rep(0, nOption)names(dkeytmp) <- OPTIONS
for(j in OPTIONS){
if (grepl(j,dkey[,i])) dkeytmp[j] <- 1}
dansitmp <- matrix(c(0), nrow=nSample, ncol=(nOption+1))
colnames(dansitmp) <- c(OPTIONS, "NA")for(j in OPTIONS){
dansitmp[,j] <- ifelse(grepl(j, dans[,i]), 1, 0)}
dansitmp[,"NA"] <- ifelse((sum(dkeytmp) - rowSums(dansitmp))>=0, (sum(dkeytmp) - rowSums(dansitmp)), 0)# choice ratio of each option per item
dita[i,c(optionNames,"oNA")] <- floor(10^rdgts *(colMeans(dansitmp)+0.005))/ 10^rdgts# each item analysis
v2 <- c(i, as.character(dkey[1,i]), dita[i,"N"],dita[i,"P"], dita[i, "D"], dita[i,"Corr"], dita[i, "Alpha"], dita[i, "Dalpha"])v3 <- c("Prop", OPTIONS,"NA")v4 <- c("All", dita[i,c(optionNames,"oNA")])# UML based
dsortitmp <- dsort[order(dsort[,idName]),c(idName,i,"Total","LMU")]
dansitmp <- cbind(dsortitmp, dansitmp)
dansitmpL <- dansitmp[dansitmp[,"LMU"]=="L",]dansitmpM <- dansitmp[dansitmp[,"LMU"]=="M",]dansitmpU <- dansitmp[dansitmp[,"LMU"]=="U",]v5 <- c("U", (floor(10^rdgts * (colMeans(dansitmpU[,c(OPTIONS,"NA")])+0.005))/ 10^rdgts))
v6 <- c("M", (floor(10^rdgts * (colMeans(dansitmpM[,c(OPTIONS,"NA")])+0.005))/ 10^rdgts))
v7 <- c("L", (floor(10^rdgts * (colMeans(dansitmpL[,c(OPTIONS,"NA")])+0.005))/ 10^rdgts))
v8 <- c("D", (floor(10^rdgts * (colMeans(dansitmpU[,c(OPTIONS,"NA")])-colMeans(dansitmpL[,c(OPT
IONS,"NA")])+0.005))/ 10^rdgts))
v9 <- c("Corr", (floor(10^rdgts * (cor( dansitmp[,c(OPTIONS,"NA")],(dansitmp[,"Total"]-dansitmp[,i]),
use = "pairwise.complete.obs")+0.005)) / 10^rdgts))
v10 <- rep("",length(v5))
nemp <- length(v3) - length(v1)if (nemp >=0) {v1 <- c(v1, rep("",nemp))
v2 <- c(v2, rep("",nemp))} else {nemp <- abs(nemp)
v3 <- c(v3, rep("",nemp))
v4 <- c(v4, rep("",nemp))
v5 <- c(v5, rep("",nemp))
v6 <- c(v6, rep("",nemp))
v7 <- c(v7, rep("",nemp))
v8 <- c(v8, rep("",nemp))
v9 <- c(v9, rep("",nemp))
v10 <- c(v10, rep("",nemp))}
temp <- rbind(v1, v2, v3, v4 ,v5,v6,v7,v8,v9,v10)
drei <- rbind(drei, temp)}#remove dansitmpL, dansitmpM, dansitmpU
rm(dansitmpL, dansitmpM, dansitmpU)#remove v1,v2,v3,v4,v5,v6,v7,v8,v9,v10
rm(v1,v2,v3,v4,v5,v6,v7,v8,v9,v10)474

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部# Output Item Analysis Results
colnames(dita) <- c("Item","N","P","D","Corr","Alpha","Dalpha","Key",OPTIONS,"NA")write.table(dita, itaFileName, row.names=F, sep=",", fileEncoding="shift-jis")write.table(drei, reiFileName, row.names=F, col.names=F, sep=",", fileEncoding="shift-jis")#remove dita, dreirm(dita, drei)# Trace lines
pdf(trlFileName, paper="a4", width=7, height=14, family="Japan1", onefile=T)
layout(matrix(c(1,2,3,4,5,6), 3,2, byrow=T))
par(mar=c(6,5,2,1))
for(i in itemNames){# subjects*options matrix per item
dkeytmp <- rep(0, nOption)names(dkeytmp) <- OPTIONS
for(j in OPTIONS){
if (grepl(j,dkey[,i])) dkeytmp[j] <- 1}
dansitmp <- matrix(c(0), nrow=nSample, ncol=(nOption+1))
colnames(dansitmp) <- c(OPTIONS, "NA")for(j in OPTIONS){
dansitmp[,j] <- ifelse(grepl(j, dans[,i]), 1, 0)}
dansitmp[,"NA"] <- ifelse((sum(dkeytmp) - rowSums(dansitmp))>=0, (sum(dkeytmp) - rowSums(dansitmp)), 0)dsortitmp <- dsort[order(dsort[,idName]),c(idName,"LMU","sortID")]dansitmp <- cbind(dsortitmp, dansitmp)
dansitmp <- dansitmp[order(dansitmp[,"sortID"]),]
dansitmp$group <- NGROUP
if ((NGROUP==3) && (KELLEY==TRUE)) {dansitmp$group[1:nSub] <- 1
dansitmp$group[(nSub+1):(nSample-nSub)] <- 2
dansitmp$group[(nSample-nSub+1):nSample] <- 3
} else {nEach <- floor(nSample/NGROUP +0.5)
for(igp in 1:(NGROUP-1)){
hb <- (igp-1)*nEach+1
he <- igp*nEachdansitmp$group[hb:he] <- igp}}
ioprop <- matrix(c(0), nrow=(nOption+1), ncol=NGROUP)
rownames(ioprop) <- c(OPTIONS,"NA")colnames (ioprop) <- c(1:NGROUP)
lwdv <- rep(1, (nOption+1))
lwdv <- 1.5*c(dkeytmp,0) + lwdv
names(lwdv) <- c(OPTIONS,"NA")for(j in 1:NGROUP){
dansitmpj <- dansitmp[dansitmp$group==j,]ioprop[,j] <- colMeans(dansitmpj[,c(OPTIONS,"NA")])}plot(c(1:NGROUP), ioprop["NA",], xlim=c(1, NGROUP), ylim =c(0,1), las=1, axes=F,
xlab="Group", ylab="Proportion of Being Selected",
pch="-", type="b", lty=1, lwd=lwdv["NA"], main=i)axis(side=1, c(1:NGROUP))
axis(side=2, seq(0,1, 0.1), las=1)
for (j in OPTIONS){
par(new=T)
475

名古屋大学}大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

plot(c(1:NGROUP), ioprop[j,], xlim=c(1, NGROUP), ylim =c(0,1), las=1, axes=F,
pch=j, type="b", lty=1, lwd=lwdv[j], xlab="", ylab="", xaxt="n", yaxt="n")}dev.off()

476

名古屋大学項目分析－

大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

itemanalysisパッケージ

多枝選択項目の項目分析を行う。
library(ITEMAN)
オブジェクト名 <- itemanalysis1(data=回答データ,
key=正答キー,
options=選択式号ベクトル,
ngroup=群数,
correction=TRUE)
オブジェクト名$plots[項目番号]
あらかじめitemanalysisパッケージをインストールしておく必要がある．
パッケージがうまく展開されないときは，最新版のRをダウンロードして，パッケージのインストールからやり直す．
トレースライン作成にあたっては，得点可能範囲を均等幅に分割して群を構成している．

> rm(list=ls())> setwd("d:\\")> # Answer file name> ansFileName <- "IWS3_ANS.csv">> # Key file name> keyFileName <- "IWS3_KEY.csv"> dans0 <- read.table(ansFileName, header=T, sep=",", fileEncoding="shift-jis")> dkey0 <- read.table(keyFileName, header=T, sep=",", fileEncoding="shift-jis")> 不必要な列の削除> dans <- dans0[,-1]> dkey <- t(dkey0[,-1])# 正答キーを縦ベクトルに変換しておく> head(dkey)
[,1]
Item1
5
Item2
1
Item3
2
Item4
2
Item5
2
Item6
4>
>
> # 項目分析> library(itemanalysis)>> item.analysis <- itemanalysis1(data=dans,+
key=dkey,+
options=c("1","2","3","4","5"),+ngroup=4,+
correction=TRUE)> # 実行結果************************************************************************
itemanalysis: An R package for Classical Test Theory Item Analysis
Cengiz Zopluoglu
University of Miami
Department of Educational and Psychological Studies
Research, Measurement, and Evaluation Program
c.zopluoglu@miami.edu
Please report any programming bug or problem you experience to improve the code.
*************************************************************************
477

名古屋大学
Processing Date:

大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

Tue Jan 29 16:28:39 2019
ITEM STATISTICS

Item 1
Item 2Item 3Item 4Item 5Item 6Item 7Item 8Item 9Item 10Item 11
Item 12Item 13
Item 14
Item 15
Item 16
Item 17
Item 18
Item 19
Item 20
Item 21
Item 22
Item 23
Item 24
Item 25
Item 26
Item 27
Item 28
Item 29
Item 30

Item Difficulty Item Threshold Point-Biserial Biserial
0.784-0.786
0.225
0.317
0.727
-0.604
0.243
0.325
0.937
-1.530
0.116
0.228
0.842
-1.003
0.173
0.262
0.480
0.050
0.417
0.523
0.382
0.300
0.248
0.316
0.747
-0.665
0.073
0.099
0.307
0.504
0.053
0.070
0.289
0.556
0.020
0.027
0.279
0.586
0.151
0.202
0.273
0.604
0.054
0.072
0.639
-0.356
0.223
0.285
0.598
-0.248
0.044
0.056
0.465
0.088
0.391
0.491
0.383
0.298
0.289
0.368
0.443
0.143
0.174
0.219
0.412
0.222
0.415
0.524
0.631
-0.335
0.353
0.452
0.585
-0.215
0.283
0.358
0.208
0.813
0.093
0.131
0.558
-0.146
0.254
0.319
0.395
0.266
0.185
0.235
0.371
0.329
0.344
0.440
0.548
-0.121
0.403
0.507
0.522
-0.055
0.185
0.232
0.532
-0.080
0.261
0.328
0.327
0.448
0.172
0.224
0.580
-0.202
0.058
0.073
0.298
0.530
0.344
0.454
0.468
0.080
0.265
0.333

DISTRACTOR SELECTION PROPORTIONS
1
2
3
4
5
Item 1 0.070 0.074 0.046 0.026 0.784
Item 2 0.727 0.028 0.015 0.029 0.201
Item 3 0.011 0.937 0.022 0.015 0.015
Item 4 0.100 0.842 0.025 0.018 0.015
Item 5 0.097 0.480 0.085 0.316 0.022
Item 6 0.043 0.351 0.104 0.382 0.120
Item 7 0.042 0.747 0.062 0.056 0.093
Item 8 0.026 0.307 0.049 0.604 0.014
Item 9 0.031 0.289 0.495 0.168 0.017
Item 10 0.016 0.452 0.120 0.279 0.133
Item 11 0.273 0.242 0.199 0.197 0.089
Item 12 0.058 0.145 0.639 0.103 0.055
Item 13 0.046 0.191 0.598 0.117 0.048
Item 14 0.201 0.114 0.135 0.085 0.465
Item 15 0.032 0.095 0.383 0.343 0.147
Item 16 0.025 0.089 0.334 0.443 0.109
Item 17 0.412 0.121 0.234 0.090 0.143
Item 18 0.094 0.154 0.631 0.060 0.061
Item 19 0.116 0.175 0.585 0.084 0.040
Item 20 0.044 0.130 0.490 0.128 0.208
Item 21 0.040 0.121 0.558 0.192 0.089
Item 22 0.073 0.395 0.177 0.077 0.278
Item 23 0.074 0.194 0.209 0.152 0.371
Item 24 0.049 0.548 0.122 0.125 0.156
Item 25 0.060 0.184 0.522 0.137 0.097
Item 26 0.042 0.136 0.201 0.089 0.532
Item 27 0.066 0.160 0.397 0.327 0.050
Item 28 0.061 0.580 0.102 0.052 0.205
Item 29 0.094 0.279 0.191 0.138 0.298
Item 30 0.099 0.158 0.213 0.468 0.062478

名古屋大学

DISTRACTOR Point-Biserial
1
2
3
4
5
Item 1 -0.062 -0.089 -0.190 -0.087 0.225
Item 20.243 -0.126 -0.096 -0.085 -0.153
Item 3 -0.078 0.116 -0.078 -0.058 -0.013
Item 4 -0.127 0.173 -0.087 -0.069 -0.020
Item 5 -0.053 0.417 -0.148 -0.286 -0.124
Item 6
0.031 -0.048 -0.139 0.248 -0.189
Item 7 -0.078 0.073 -0.111 0.030 0.014
Item 8 -0.039 0.053 -0.085 -0.003 0.012
Item 9 -0.084 0.020 0.164 -0.180 -0.071
Item 10 -0.053 0.069 -0.225 0.151 -0.066
Item 11 0.054 -0.034 -0.003 -0.005 -0.021
Item 12 -0.048 -0.174 0.223 -0.052 -0.081
Item 13 0.030 -0.050 0.044 -0.007 -0.030
Item 14 -0.074 -0.224 -0.154 -0.150 0.391
Item 15 -0.144 -0.225 0.289 -0.160 0.076
Item 16 -0.101 -0.151 -0.060 0.174 0.003
Item 17 0.415 -0.208 -0.241 -0.185 0.053
Item 18 -0.117 -0.232 0.353 -0.146 -0.073
Item 19 -0.110 -0.166 0.283 -0.103 -0.066
Item 20 -0.091 -0.171 0.161 -0.126 0.093
Item 21 -0.145 -0.227 0.254 -0.090 0.042
Item 22 -0.083 0.185 -0.174 -0.134 0.074
Item 23 -0.054 -0.200 -0.112 -0.075 0.344
Item 24 -0.093 0.403 -0.200 -0.168 -0.165
Item 25 -0.104 -0.138 0.185 -0.063 0.024
Item 26 -0.069 -0.132 -0.106 -0.101 0.261
Item 27 0.031 -0.118 -0.083 0.172 -0.020
Item 28 0.052 0.058 -0.006 0.007 -0.101
Item 29 -0.067 -0.186 -0.126 -0.014 0.344
Item 30 -0.046 -0.166 -0.123 0.265 -0.033

DISTRACTOR Biserial
1
2
3
4
5
Item 1 -0.118 -0.166 -0.412 -0.229 0.317
Item 20.325 -0.324 -0.308 -0.214 -0.219
Item 3 -0.280 0.228 -0.219 -0.186 -0.043
Item 4 -0.216 0.262 -0.232 -0.207 -0.064
Item 5 -0.092 0.523 -0.266 -0.374 -0.347
Item 6
0.069 -0.062 -0.235 0.316 -0.306
Item 7 -0.175 0.099 -0.219 0.061 0.024
Item 8 -0.103 0.070 -0.180 -0.004 0.039
Item 9 -0.209 0.027 0.205 -0.268 -0.216
Item 10 -0.165 0.087 -0.366 0.202 -0.104
Item 11 0.072 -0.047 -0.005 -0.008 -0.038
Item 12 -0.097 -0.269 0.285 -0.088 -0.166
Item 13 0.066 -0.072 0.056 -0.012 -0.063
Item 14 -0.105 -0.370 -0.243 -0.268 0.491
Item 15 -0.352 -0.391 0.368 -0.207 0.117
Item 16 -0.269 -0.267 -0.078 0.219 0.005
Item 17 0.524 -0.336 -0.333 -0.327 0.082
Item 18 -0.204 -0.353 0.452 -0.292 -0.145
Item 19 -0.180 -0.245 0.358 -0.184 -0.149
Item 20 -0.202 -0.272 0.202 -0.201 0.131
Item 21 -0.330 -0.368 0.319 -0.130 0.075
Item 22 -0.157 0.235 -0.255 -0.247 0.099
Item 23 -0.101 -0.288 -0.159 -0.115 0.440
Item 24 -0.198 0.507 -0.324 -0.269 -0.250
Item 25 -0.206 -0.201 0.232 -0.099 0.041
Item 26 -0.154 -0.207 -0.151 -0.179 0.328
Item 27 0.059 -0.178 -0.105 0.224 -0.043
Item 28 0.103 0.073 -0.010 0.014 -0.144
Item 29 -0.116 -0.248 -0.183 -0.023 0.454
Item 30 -0.079 -0.251 -0.173 0.333 -0.064479

大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部

名古屋大学大 学 院 教 育 発 達 科 学 研究 科 ・ 教 育 学 部> # トレースラインの表示> item.analysis$plots[[1]][[1]]> # 群平均の値の取り出し> item.analysis$plots[[1]][1]
$data
sg
p
opt
(2.98,9]5.99 0.106194690 1( -0.12 )(9,15]
12.00 0.081585082 1( -0.12 )(15,21]18.00 0.056300268 1( -0.12 )(21,27]24.00 0.023529412 1( -0.12 )(2.98,9]1 5.99 0.123893805 2( -0.17 )(9,15]1
12.00 0.097902098 2( -0.17 )(15,21]1 18.00 0.042895442 2( -0.17 )(21,27]1 24.00 0.023529412 2( -0.17 )(2.98,9]2 5.99 0.168141593 3( -0.41 )(9,15]2
12.00 0.060606061 3( -0.41 )(15,21]2 18.00 0.002680965 3( -0.41 )(21,27]2 24.00 0.000000000 3( -0.41 )(2.98,9]3 5.99 0.070796460 4( -0.23 )(9,15]3
12.00 0.027972028 4( -0.23 )(15,21]3 18.00 0.016085791 4( -0.23 )(21,27]3 24.00 0.000000000 4( -0.23 )(2.98,9]4 5.99 0.530973451 5( 0.32 )(9,15]4
12.00 0.731934732 5( 0.32 )(15,21]4 18.00 0.882037534 5( 0.32 )(21,27]4 24.00 0.952941176 5( 0.32 )> # すべての項目のトレースラインをPDFファイルに出力>> pdf("TraceLineFigures.pdf", paper="a4", width=7, height=7, family="Japan1")>> item.analysis$plots>> layout(1)> dev.off()
windows2
480

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

項目パラメタの推定 ― 1PL,2PL,3PLモデル
四分相関係数の計算
library(polycor)
library(psych)
オブジェクト名 <- polychoric(データフレーム名)
相関行列名 <- オブジェクト名$rho
あらかじめpolycorパッケージとpsychパッケージをインストールしておく必要がある．
polycorの出力には四分相関係数以外のものも含まれるので，$rhoで四分相関係数だけを切り取る．
一次元性の確認
VSS.scree(相関行列名)
fa.parallel関数を使う方法
library(psych)
fa.parallel(データ名, fa = "pc")
あらかじめpsychパッケージをインストールしておく必要がある．
スクリープロットを表示する．
項目パラメタの推定
library(ltm)
library(irtoys)
オブジェクト名 <- est(resp=データフレーム名, model="モデル名",engine="ltm")
あらかじめltmパッケージとirtoysパッケージをインストールしておく必要がある．
model には "1PL", "2PL", "3PL" を指定できる．
engine には "icl", "bilog", "ltm" を指定できる．"ltm" にしておくとRだけで完結するが，"bilog"などとするとBILOGソフトが別途必要になる．

> setwd("d:\\")> d1 <- read.table("irt_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
1
2
3
4
5
6
>

s03 s04 s05 s06 s07 s08 s09 s12 s14 s15 s16
1
1
1
1
1
0
1
1
1
1
1
1
1
1
0
1
0
0
1
0
0
0
1
1
1
1
1
1
1
1
1
1
1
1
1
1
0
1
0
0
0
0
0
0
1
1
1
0
1
0
0
1
1
1
0
1
1
0
1
0
0
0
0
0
1
0

> # 人数> nrow(d1)[1] 778>> # 項目正答率> (pv <- colMeans(d1))
s03
s04
s05
s06
s07
s08
s09
0.71208226 0.82519280 0.73778920 0.73007712 0.88688946 0.06298201 0.56683805
s12
s14
s15
s16
0.53727506 0.55398458 0.58097686 0.44344473>

481

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 四分相関係数の計算> library(polycor)> library(psych)> t.cor <- polychoric(d1)> t.cor <- t.cor$rho> round(t.cor, 2)s03 s04 s05 s06 s07 s08 s09 s12 s14 s15 s16
s03 1.00 0.06 0.33 0.34 0.21 0.10 0.25 0.30 0.12 0.15 0.27
s04 0.06 1.00 0.31 0.33 0.24 0.16 0.10 0.15 0.17 0.16 0.21
s05 0.33 0.31 1.00 0.52 0.29 0.35 0.32 0.40 0.26 0.24 0.29
s06 0.34 0.33 0.52 1.00 0.48 0.14 0.38 0.38 0.30 0.25 0.40
s07 0.21 0.24 0.29 0.48 1.00 0.36 0.48 0.42 0.48 0.37 0.41
s08 0.10 0.16 0.35 0.14 0.36 1.00 0.38 0.29 0.13 0.27 0.24
s09 0.25 0.10 0.32 0.38 0.48 0.38 1.00 0.27 0.27 0.33 0.35
s12 0.30 0.15 0.40 0.38 0.42 0.29 0.27 1.00 0.40 0.28 0.53
s14 0.12 0.17 0.26 0.30 0.48 0.13 0.27 0.40 1.00 0.31 0.35
s15 0.15 0.16 0.24 0.25 0.37 0.27 0.33 0.28 0.31 1.00 0.35
s16 0.27 0.21 0.29 0.40 0.41 0.24 0.35 0.53 0.35 0.35 1.00>

> # 一次元性の確認> # VSS.scree を使う方法> VSS.scree(t.cor)>>> # fa.parallel関数を使う方法> library(psych)> fa.parallel(d1, fa = "pc")Parallel analysis suggests that the number of factors =2
1

values3

4scree plot

2

4

6

8

10

Index

> # 項目母数の推定> library(ltm)> library(irtoys)> p.all <- est(resp=d1, model="2PL",engine="ltm")> colnames(p.all$est) <- c("aj", "bj","cj")> colnames(p.all$se) <- c("aj", "bj","cj")> rownames(p.all$se) <- rownames(p.all$est)> p.all482

NAand the number of components =1

名古屋 大学$est# 項目母数の推定値

aj
bj cj
s03 0.7519081 -1.3479054 0
s04 0.6336668 -2.6447011 0
s05 1.2141256 -1.0870115 0
s06 1.4940753 -0.9263137 0
s07 1.7233574 -1.7290162 0
s08 0.9815908 3.1497698 0
s09 1.0866067 -0.3036178 0
s12 1.4498429 -0.1380151 0
s14 1.0159834 -0.2558882 0
s15 0.9046749 -0.4216555 0
s16 1.4752955 0.2216158 0$se# 標準誤差$vcm$vcm[[1]]# 分散共分散行列aj
bj cj
s03 0.1155375 0.20441485 0
s04 0.1250574 0.47668423 0
s05 0.1526624 0.12175749 0
s06 0.1800035 0.09653309 0
s07 0.2457579 0.15253089 0
s08 0.2276118 0.58227949 0
s09 0.1333925 0.08662509 0
s12 0.1680297 0.06968662 0
s14 0.1275844 0.08936450 0
s15 0.1194251 0.10329955 0
s16 0.1764927 0.06974481 0

[,1]
[,2]
[1,] 0.01334892 0.01938195[2,] 0.01938195 0.04178543$vcm[[2]]

[,1]
[,2]
[1,] 0.01563935 0.05625316[2,] 0.05625316 0.22722786$vcm[[3]][,1][,2][1,] 0.0233058 0.01345200[2,] 0.0134520 0.01482489$vcm[[4]][,1][,2][1,] 0.03240126 0.011221411[2,] 0.01122141 0.009318638$vcm[[5]][,1][,2][1,] 0.06039696 0.03077978[2,] 0.03077978 0.02326567$vcm[[6]][,1][,2][1,] 0.05180715 -0.1273928[2,] -0.12739281 0.3390494$vcm[[7]][,1][,2][1,] 0.017793546 0.003502177[2,] 0.003502177 0.007503907$vcm[[8]][,1][,2][1,] 0.028233972 0.001676149[2,] 0.001676149 0.004856224$vcm[[9]]
[,1]

[,2]
483

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部[1,] 0.016277785 0.003006243[2,] 0.003006243 0.007986014$vcm[[10]]

[,1]
[,2]
[1,] 0.014262349 0.005055913[2,] 0.005055913 0.010670797$vcm[[11]]
[,1]
[,2]
[1,] 0.031149668 -0.002364131[2,] -0.002364131 0.004864339# 項目困難度と項目識別力の散布図
plot(p.all$est[,"bj"], p.all$est[,"aj"], pch=20)>> # 項目正答率と困難度の散布図> plot(pv, p.all$est[,"bj"], xlim=c(0,1), ylim=c(-3,1), pch=20)484

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

特性関数・情報関数の図示
library(irtoys)
あらかじめltmパッケージとirtoysパッケージをインストールしておく必要がある．
項目特性曲線
plot(irf(項目パラメタデータ行列))
項目情報曲線
plot(iif(項目パラメタデータ行列))
テスト特性曲線
plot(trf(項目パラメタデータ行列))
テスト情報曲線
plot(tif(項目パラメタデータ行列))
項目パラメタデータ行列を1項目の項目パラメタだけにすれば，その項目だけの特性曲線を描く．
項目パラメタデータ行列に複数の項目パラメタを入れれば，それらすべての特性曲線を描く．

> setwd("d:\\")> d1 <- read.table("irt_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>>>> # 項目母数の推定> library(ltm)> library(irtoys)> p.all <- est(resp=d1, model="2PL",engine="ltm")> colnames(p.all$est) <- c("aj", "bj","cj")> colnames(p.all$se) <- c("aj", "bj","cj")> rownames(p.all$se) <- rownames(p.all$est)> p.all$est# 項目母数の推定値

aj
bj cj
s03 0.7519081 -1.3479054 0
s04 0.6336668 -2.6447011 0
s05 1.2141256 -1.0870115 0
s06 1.4940753 -0.9263137 0
s07 1.7233574 -1.7290162 0
s08 0.9815908 3.1497698 0
s09 1.0866067 -0.3036178 0
s12 1.4498429 -0.1380151 0
s14 1.0159834 -0.2558882 0
s15 0.9046749 -0.4216555 0
s16 1.4752955 0.2216158 0$se# 標準誤差aj
bj cj
s03 0.1155375 0.20441485 0
s04 0.1250574 0.47668423 0
s05 0.1526624 0.12175749 0
s06 0.1800035 0.09653309 0
s07 0.2457579 0.15253089 0
s08 0.2276118 0.58227949 0
s09 0.1333925 0.08662509 0
s12 0.1680297 0.06968662 0
s14 0.1275844 0.08936450 0
s15 0.1194251 0.10329955 0
s16 0.1764927 0.06974481 0
$vcm
# 省略
485

名古屋 大学>> # 特性関数，情報関数の図示>> # 項目特性曲線> plot(irf(p.all$est["s06",]))>>> # 図出力画面を2*2に分割> par(mfrow=c(2,2))>> # 項目特性曲線> plot(irf(p.all$est), co=NA, label=TRUE)>> # テスト特性曲線> plot(trf(p.all$est))>> # 項目情報曲線> plot(iif(p.all$est), co=NA, label=TRUE)>> # テスト情報曲線> plot(tif(p.all$est))>>> # 図出力画面を1*1に戻す> par(mfrow=c(1,1))>

486

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

特性値の推定library(irtoys)
あらかじめirtoysパッケージをインストールしておく必要がある．
最尤推定値・ベイズモーダル推定値
mlebme(resp=データ行列, ip=項目パラメタ行列, method="推定方法")
method を"ML"または省略すると最尤推定値，"BM"とするとベイズモーダル推定値を計算する．
"BM"とした場合は mu= と sigma= で事前分布（正規分布）を指定する．デフォルトは標準正規分布．
期待事後推定値
eap(resp=データ行列, ip=項目パラメタ行列, qu=normal.qu())
qu は求積点と重みの指定をする．標準正規分布の場合 qu=normal.qu() とする．

> setwd("d:\\")> d1 <- read.table("irt_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)s03 s04 s05 s06 s07 s08 s09 s12 s14 s15 s16
1
1
1
1
1
1
0
1
1
1
1
1
2
1
1
1
0
1
0
0
1
0
0
0
3
1
1
1
1
1
1
1
1
1
1
1
4
1
1
1
0
1
0
0
0
0
0
0
5
1
1
1
0
1
0
0
1
1
1
0
6
1
1
0
1
0
0
0
0
0
1
0
>
>
> # 項目母数の推定> library(ltm)> library(irtoys)> p.all <- est(resp=d1, model="2PL",engine="ltm")> colnames(p.all$est) <- c("aj", "bj","cj")> colnames(p.all$se) <- c("aj", "bj","cj")> rownames(p.all$se) <- rownames(p.all$est)> p.all
$est
aj
bj cj
s03 0.7519081 -1.3479054 0
s04 0.6336668 -2.6447011 0
s05 1.2141256 -1.0870115 0
s06 1.4940753 -0.9263137 0
s07 1.7233574 -1.7290162 0
s08 0.9815908 3.1497698 0
s09 1.0866067 -0.3036178 0
s12 1.4498429 -0.1380151 0
s14 1.0159834 -0.2558882 0
s15 0.9046749 -0.4216555 0
s16 1.4752955 0.2216158 0
$se
aj
bj cj
s03 0.1155375 0.20441485 0
s04 0.1250574 0.47668423 0
s05 0.1526624 0.12175749 0
s06 0.1800035 0.09653309 0
s07 0.2457579 0.15253089 0
s08 0.2276118 0.58227949 0
s09 0.1333925 0.08662509 0
s12 0.1680297 0.06968662 0
s14 0.1275844 0.08936450 0
s15 0.1194251 0.10329955 0
s16 0.1764927 0.06974481 0
>
$vcm
487

名古屋 大学$vcm[[1]]# 省略> # 特性値の推定> # 最尤推定値> th.bme <- mlebme(resp=d1, ip=p.all$est)> head(th.bme)
est
sem n
[1,] 2.4947583 1.3271304 11[2,] -0.7873886 0.5763237 11[3,] 3.9999379 1.9051382 11[4,] -1.2792655 0.5933037 11[5,] -0.1386948 0.5942225 11[6,] -1.4734953 0.6085549 11> # 期待事後推定値> th.eap <- eap(resp=d1, ip=p.all$est, qu=normal.qu())> head(th.eap)
est
sem n
[1,] 1.26809690 0.6508009 11[2,] -0.58653249 0.5089365 11[3,] 1.71697773 0.7015662 11[4,] -0.96204634 0.5107556 11[5,] -0.07748696 0.5242392 11[6,] -1.10349864 0.5143460 11>>> # 特性値のヒストグラム> est.bme <- th.bme[,c("est")]> est.eap <- th.eap[,c("est")]> est.raw <- rowSums(d1)>> par(mfrow=c(2,2))> hist(est.bme)> hist(est.eap)> hist(est.raw)> par(mfrow=c(1,1))> # 特性値の散布図> ests <- cbind(est.bme, est.eap, est.raw)> pairs(ests)>

488

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

局所独立性の確認
正答確率の推定
正答確率推定データ <- irf(ip= 項目パラメタ, x = 特性値)
実際の正誤と正答確率推定値の残差残差データ <- 正誤データ - 正答確率推定データ
Q3統計量
cor(残差データ)
絶対値0.2以上なら局所独立の仮定に問題ありと考える

項目適合度
itf(resp=データ, item=項目番号, ip=項目パラメタ, theta=特性値)
適合度検定。帰無仮説が「適合している」であることに注意> setwd("d:\\")> d1 <- read.table("irt_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)s03 s04 s05 s06 s07 s08 s09 s12 s14 s15 s16
1
1
1
1
1
1
0
1
1
1
1
1
2
1
1
1
0
1
0
0
1
0
0
0
3
1
1
1
1
1
1
1
1
1
1
1
4
1
1
1
0
1
0
0
0
0
0
0
5
1
1
1
0
1
0
0
1
1
1
0
6
1
1
0
1
0
0
0
0
0
1
0
>
>
> # 項目母数の推定> library(ltm)> library(irtoys)> p.all <- est(resp=d1, model="2PL",engine="ltm")> colnames(p.all$est) <- c("aj", "bj","cj")> colnames(p.all$se) <- c("aj", "bj","cj")> rownames(p.all$se) <- rownames(p.all$est)> p.all
$est
aj
bj cj
s03 0.7519081 -1.3479054 0
s04 0.6336668 -2.6447011 0
s05 1.2141256 -1.0870115 0
s06 1.4940753 -0.9263137 0
s07 1.7233574 -1.7290162 0
s08 0.9815908 3.1497698 0
s09 1.0866067 -0.3036178 0
s12 1.4498429 -0.1380151 0
s14 1.0159834 -0.2558882 0
s15 0.9046749 -0.4216555 0
s16 1.4752955 0.2216158 0
$se
aj
bj cj
s03 0.1155375 0.20441485 0
s04 0.1250574 0.47668423 0
s05 0.1526624 0.12175749 0
s06 0.1800035 0.09653309 0
s07 0.2457579 0.15253089 0
s08 0.2276118 0.58227949 0
s09 0.1333925 0.08662509 0
s12 0.1680297 0.06968662 0
s14 0.1275844 0.08936450 0
s15 0.1194251 0.10329955 0
s16 0.1764927 0.06974481 0
489

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

$vcm
# 省略

> # 特性値の推定> th.bme <- mlebme(resp=d1, ip=p.all$est)> head(th.bme)
est
sem n
[1,] 2.4947583 1.3271304 11[2,] -0.7873886 0.5763237 11[3,] 3.9999379 1.9051382 11[4,] -1.2792655 0.5933037 11[5,] -0.1386948 0.5942225 11[6,] -1.4734953 0.6085549 11> th.eap <- eap(resp=d1, ip=p.all$est, qu=normal.qu())> head(th.eap)
est
sem n
[1,] 1.26809690 0.6508009 11[2,] -0.58653249 0.5089365 11[3,] 1.71697773 0.7015662 11[4,] -0.96204634 0.5107556 11[5,] -0.07748696 0.5242392 11[6,] -1.10349864 0.5143460 11> # 正答確率の推定> cr.est <- irf(ip= p.all$est, x = th.bme[, 1])> round(head(cr.est$f),2)
s03 s04 s05 s06 s07 s08 s09 s12 s14 s15 s16[1,] 0.95 0.96 0.99 0.99 1.00 0.34 0.95 0.98 0.94 0.93 0.97
[2,] 0.60 0.76 0.59 0.55 0.84 0.02 0.37 0.28 0.37 0.42 0.18
[3,] 0.98 0.99 1.00 1.00 1.00 0.70 0.99 1.00 0.99 0.98 1.00
[4,] 0.51 0.70 0.44 0.37 0.68 0.01 0.26 0.16 0.26 0.32 0.10[5,] 0.71 0.83 0.76 0.76 0.94 0.04 0.54 0.50 0.53 0.56 0.37
[6,] 0.48 0.68 0.38 0.31 0.61 0.01 0.22 0.13 0.22 0.28 0.08>
> # 実際の正誤と正答確率推定値の残差> cr.rsd <- d1 - cr.est$f> round(head(cr.rsd),2)
s03 s04
s05
s06
s07
s08
s09
s12
s14
s15
s16
1 0.05 0.04 0.01 0.01 0.00 -0.34 0.05 0.02 0.06 0.07 0.03
2 0.40 0.24 0.41 -0.55 0.16 -0.02 -0.37 0.72 -0.37 -0.42 -0.18
3 0.02 0.01 0.00 0.00 0.00 0.30 0.01 0.00 0.01 0.02 0.00
4 0.49 0.30 0.56 -0.37 0.32 -0.01 -0.26 -0.16 -0.26 -0.32 -0.10
5 0.29 0.17 0.24 -0.76 0.06 -0.04 -0.54 0.50 0.47 0.44 -0.37
6 0.52 0.32 -0.38 0.69 -0.61 -0.01 -0.22 -0.13 -0.22 0.72 -0.08>> # Q3統計量。絶対値0.2以上なら局所独立の仮定に検討の余地あり> round(cor(cr.rsd, use="pairwise.complete.obs"),2)
s03
s04
s05
s06
s07
s08
s09
s12
s14
s15
s16
s03 1.00 -0.09 0.00 -0.03 -0.13 -0.06 -0.05 -0.06 -0.14 -0.10 -0.10
s04 -0.09 1.00 0.03 0.02 -0.07 -0.01 -0.11 -0.11 -0.05 -0.04 -0.07
s05 0.00 0.03 1.00 0.00 -0.22 0.00 -0.12 -0.12 -0.15 -0.13 -0.23
s06 -0.03 0.02 0.00 1.00 -0.14 -0.09 -0.12 -0.23 -0.17 -0.17 -0.20
s07 -0.13 -0.07 -0.22 -0.14 1.00 0.00 -0.04 -0.12 -0.02 -0.08 -0.12
s08 -0.06 -0.01 0.00 -0.09 0.00 1.00 0.01 -0.06 -0.09 -0.02 -0.11
s09 -0.05 -0.11 -0.12 -0.12 -0.04 0.01 1.00 -0.24 -0.12 -0.03 -0.16
s12 -0.06 -0.11 -0.12 -0.23 -0.12 -0.06 -0.24 1.00 -0.08 -0.16 -0.11
s14 -0.14 -0.05 -0.15 -0.17 -0.02 -0.09 -0.12 -0.08 1.00 -0.04 -0.13
s15 -0.10 -0.04 -0.13 -0.17 -0.08 -0.02 -0.03 -0.16 -0.04 1.00 -0.10
s16 -0.10 -0.07 -0.23 -0.20 -0.12 -0.11 -0.16 -0.11 -0.13 -0.10 1.00
490

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 項目適合度> itf(resp=d1, item=1, ip=p.all$est, theta=th.bme[, 1])
StatisticDF
P-value
4.741022e+01 7.000000e+00 4.642388e-08> itf(resp=d1, item=6, ip=p.all$est, theta=th.bme[, 1])
StatisticDF
P-value9.2211003 7.0000000 0.2371694> itf(resp=d1, item=11, ip=p.all$est, theta=th.bme[, 1])
StatisticDF
P-value
3.512343e+01 7.000000e+00 1.060259e-05
警告メッセージ:
itf(resp = d1, item = 11, ip = p.all$est, theta = th.bme[, 1]) で:
item fit statistic computed for a test of less than 20 items# 項目数が少ないと，警告メッセージが表示されることがある>491

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

等化 ― 共通項目法
library(irtoys)
あらかじめirtoysパッケージをインストールしておく必要がある．
sca(old.ip = 基準とする冊子の項目パラメタ行列,
old.items = 基準冊子における共通項目の名前または列番号,
new.ip = 基準に等化したい冊子の項目パラメタ行列,
new.items = 基準に等化したい冊子における共通項目の名前または列番号,method = "等化法")
method には "MM" (Mean/Mean), "MS" (Mean/Sigma), "SL" (Stocking-Lord), "HB" (Haebara) を指定できる．デフォルトは "MS" である．
method に "SL" または "HB" を用いた場合は，old.qu=norma.qu(), new.qu=norma.qu(), bec=FALSE な
どの指定も必要になる．

> setwd("d:\\")>> # 冊子Sのデータファイルの読み込み> ds <- read.table("irt_データ1.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(ds)s03 s04 s05 s06 s07 s08 s09 s12
冊子s データ
1
1
1
1
1
1
0
1
1
2
1
1
1
0
1
0
0
1
3
1
1
1
1
1
1
1
1
4
1
1
1
0
1
0
0
0
5
1
1
1
0
1
0
0
1
6
1
1
0
1
0
0
0
0
> # 人数> nrow(ds)[1] 380>> # 冊子tのデータファイルの読み込み> dt <- read.table("irt_データ2.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(dt)t03 t04 t05 t06 t12 t14 t15 t16
冊子t データ
1
1
1
0
0
0
1
1
0
2
0
1
1
1
1
1
0
0
3
0
1
1
1
0
1
0
0
4
1
1
1
1
1
1
1
1
5
1
0
1
1
1
1
1
0
6
0
0
0
1
0
0
0
0
> # 人数> nrow(dt)[1] 398>> # 四分相関係数の計算> library(polycor)> library(psych)> t.cor.s <- polychoric(ds)> t.cor.s <- t.cor.s$rho> round(t.cor.s, 2)492

名古屋 大学
s03
s04 s05 s06 s07 s08
s09 s12s03 1.00 -0.02 0.36 0.28 0.24 0.06 0.15 0.26
s04 -0.02 1.00 0.35 0.42 0.19 0.03 -0.03 0.21
s05 0.36 0.35 1.00 0.46 0.35 0.31 0.26 0.45
s06 0.28 0.42 0.46 1.00 0.41 0.09 0.32 0.33
s07 0.24 0.19 0.35 0.41 1.00 0.92 0.40 0.41
s08 0.06 0.03 0.31 0.09 0.92 1.00 0.36 0.22
s09 0.15 -0.03 0.26 0.32 0.40 0.36 1.00 0.23
s12 0.26 0.21 0.45 0.33 0.41 0.22 0.23 1.00>
> t.cor.t <- polychoric(dt)> t.cor.t <- t.cor.t$rho> round(t.cor.t, 2)
t03 t04 t05 t06 t12 t14 t15 t16
t03 1.00 0.14 0.29 0.40 0.34 0.09 0.23 0.28
t04 0.14 1.00 0.26 0.22 0.08 0.07 0.12 0.35
t05 0.29 0.26 1.00 0.58 0.35 0.24 0.24 0.30
t06 0.40 0.22 0.58 1.00 0.43 0.18 0.24 0.44
t12 0.34 0.08 0.35 0.43 1.00 0.34 0.27 0.55
t14 0.09 0.07 0.24 0.18 0.34 1.00 0.31 0.29
t15 0.23 0.12 0.24 0.24 0.27 0.31 1.00 0.39
t16 0.28 0.35 0.30 0.44 0.55 0.29 0.39 1.00>>
> # 一次元性の確認> # VSS.scree を使う方法> VSS.scree(t.cor.s)> VSS.scree(t.cor.t)>> # fa.parallel関数を使う方法> library(psych)> fa.parallel(ds, fa = "pc")> fa.parallel(dt, fa = "pc")

1.5
0.0

0.5

1.0

values

2.0

2.5

3.0

scree plot

1

2

3

4

5

6

7

8

6

7

8

Index

0.5

1.0

1.5

values

2.0

2.5

3.0

scree plot

1

2

3

4

5
Index

493

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学> # 項目母数の推定> library(ltm)> library(irtoys)> # 冊子s> (p.s <- est(resp=ds, model="2PL",engine="ltm"))
$est
[,1]
[,2] [,3]s03 0.7705687 -1.350058080
s04 0.7313849 -2.17329785
0
s05 1.7760631 -0.81834536
0
s06 1.5016486 -0.77167362
0
s07 1.4794851 -1.742903030
s08 0.7880403 3.53510139
0
s09 0.7771965 -0.41847844
0
s12 1.2080520 -0.06943932
0
$se

[,1]
[,2] [,3][1,] 0.1835226 0.3046659
0[2,] 0.2008428 0.5276427
0[3,] 0.3662551 0.1233839
0[4,] 0.2969631 0.1309896
0[5,] 0.3409735 0.2637599
0[6,] 0.3097197 1.1783263
0[7,] 0.1764709 0.1684350
0[8,] 0.2323375 0.1099113
0
$vcm
# 省略
> # 冊子t> (p.t <- est(resp=dt, model="2PL",engine="ltm"))
$est
[,1]
[,2] [,3]t03 0.9003816 -1.15109960
t04 0.6039492 -2.9640459
0
t05 1.2714928 -1.1421325
0
t06 1.6534735 -1.0351572
0
t12 1.5431110 -0.2142970
0
t14 0.7095130 -0.3159867
0
t15 0.8331013 -0.4619254
0
t16 1.7019090 0.1444933
0
$se
[,1]
[,2] [,3][1,] 0.1830130 0.22550849
0[2,] 0.1880158 0.84133720
0[3,] 0.2415768 0.17788000
0[4,] 0.3139183 0.14187396
0[5,] 0.2693993 0.09572488
0[6,] 0.1569843 0.16815224
0[7,] 0.1688423 0.15787306
0[8,] 0.3138695 0.08975633
0
$vcm
# 省略

> # 冊子ｔの項目母数を冊子sの尺度へ等化> # 共通項目の番号 03,04,05,06,12> # irtoys パッケージの読み込み> library(irtoys)> (p.tsa <- sca(old.ip=p.s$est, old.items=c(1:4,8),+
new.ip=p.t$est, new.items=c(1:5),+
method="MS"))494

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学$slope[1] 0.7753178$intercept[1] -0.02760581$scaled.ip[,1][,2] [,3]t03 1.1613065 -0.92007377
0
t04 0.7789699 -2.32568328
0
t05 1.6399634 -0.91312149
0
t06 2.1326397 -0.83018161
0
t12 1.9902949 -0.193754080
t14 0.9151254 -0.27259594
0
t15 1.0745288 -0.38574476
0
t16 2.1951115 0.08442242
0> # 項目パラメタだけの取り出し> (p.ts <- p.tsa$scaled.ip)[,1][,2] [,3]t03 1.1613065 -0.92007377
0
t04 0.7789699 -2.32568328
0
t05 1.6399634 -0.91312149
0
t06 2.1326397 -0.83018161
0
t12 1.9902949 -0.193754080
t14 0.9151254 -0.27259594
0
t15 1.0745288 -0.38574476
0
t16 2.1951115 0.08442242
0>> # 共通項目のパラメタ推定値の統合> # 各テストにおける共通項目のパラメタ> (p.sc <- p.s$est[c(1:4,8),])[,1][,2] [,3]s03 0.7705687 -1.350058080
s04 0.7313849 -2.17329785
0
s05 1.7760631 -0.81834536
0
s06 1.5016486 -0.77167362
0
s12 1.2080520 -0.069439320> (p.tsc <- p.ts[c(1:5),])[,1][,2] [,3]t03 1.1613065 -0.9200738
0
t04 0.7789699 -2.3256833
0
t05 1.6399634 -0.9131215
0
t06 2.1326397 -0.8301816
0
t12 1.9902949 -0.1937541
0> # 困難度パラメタの統合（幾何平均）> p.c <- p.sc
> p.c[,1] <- sqrt(p.sc[,1] * p.tsc[,1])> # 識別力パラメタの統合（算術平均）> p.c[,2] <- (p.sc[,2] + p.tsc[,2])/2
>
> p.c
[,1]
[,2] [,3]s03 0.9459738 -1.1350659
0
s04 0.7548025 -2.2494906
0
s05 1.7066571 -0.8657334
0
s06 1.7895462 -0.8009276
0
s12 1.5506062 -0.1315967
0
>

495

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 共通でない項目のパラメタ推定値> (p.sr <- p.s$est[c(-1:-4,-8),])[,1][,2] [,3]s07 1.4794851 -1.74290300
s08 0.7880403 3.5351014
0
s09 0.7771965 -0.4184784
0> (p.tsr <- p.ts[c(-1:-5),])[,1][,2] [,3]t14 0.9151254 -0.27259594
0
t15 1.0745288 -0.38574476
0
t16 2.1951115 0.08442242
0>> # 等化による全項目のパラメタ推定値> p.all2 <- rbind(p.c, p.sr,p.tsr)> p.all2 <- p.all2[order(rownames(p.all2)),]> colnames(p.all2) <- c("aj", "bj","cj")> p.all2
aj
bj cj
s03 0.9459738 -1.13506592 0
s04 0.7548025 -2.24949057 0
s05 1.7066571 -0.86573343 0
s06 1.7895462 -0.80092762 0
s07 1.4794851 -1.74290303 0
s08 0.7880403 3.53510139 0
s09 0.7771965 -0.41847844 0
s12 1.5506062 -0.13159670 0
t14 0.9151254 -0.27259594 0
t15 1.0745288 -0.38574476 0
t16 2.1951115 0.08442242 0>>>> # 冊子tの特性値の推定> # irtoys パッケージの読み込み> library(irtoys)> # 等化前> th.bme.t <- mlebme(resp=dt, ip=p.t$est)> th.bme.t.est <- th.bme.t[,c("est")]> th.eap.t <- eap(resp=dt, ip=p.t$est, qu=normal.qu())> th.eap.t.est <- th.eap.t[,c("est")]> # 等化後> th.bme.ts <- mlebme(resp=dt, ip=p.ts)> th.bme.ts.est <- th.bme.ts[,c("est")]> th.eap.ts <- eap(resp=dt, ip=p.ts, qu=normal.qu())> th.eap.ts.est <- th.eap.ts[,c("est")]>> # 特性値の散布図> ests <- cbind(th.bme.t.est, th.bme.ts.est, th.eap.t.est, th.eap.ts.est)> head(ests)
th.bme.t.est th.bme.ts.est th.eap.t.est th.eap.ts.est[1,]-1.2652978-1.0086251 -0.90675320-0.82829364[2,]-0.1503728-0.1441932 -0.08149246-0.09018378[3,]-0.7586096-0.6157533 -0.54713042-0.50443501[4,]3.9999352
3.9999494
1.20872178
1.19630733[5,]0.3409068
0.2367043
0.28316218
0.24147003[6,]-2.0756327-1.6368788 -1.35604568-1.25386145

496

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> pairs(ests)> round(cor(ests),3)th.bme.t th.bme.ts th.eap.t th.eap.ts
th.bme.t
1.000
0.993
0.943
0.953
th.bme.ts
0.993
1.000
0.901
0.914
th.eap.t
0.943
0.901
1.000
0.999
th.eap.ts
0.953
0.914
0.999
1.000

# 同じ推定法であれば，等化の# 前後の特性値はほぼ完全な相関

-2

0

2

4

-2.0

-1.0

0.0

1.0

2

4

-4

2

4

-4

-2

0

th.bme.t

0.0

1.0

-4

-2

0

th.bme.ts

0.0

1.0

-2.0

-1.0

th.eap.t

-2.0

-1.0

th.eap.ts

-4

497

-2

0

2

4

-2.0

-1.0

0.0

1.0

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ＤＩＦ分析
パッケージの読み込み
library(difR)
あらかじめdifRパッケージを読み込んでおく必要がある
一般化Lordカイ２乗法
difGenLord(データ名, group="グループ変数名", focal.names=c("焦点群１","焦点群２",…),
nrFocal=焦点群の数, model="IRTモデル名"))
一般化マンテル-ヘンツェル法
difGMH(データ名, group="グループ変数名", focal.names=c("焦点群１","焦点群２",…)))
一般化ロジスティック回帰法
difGenLogistic(データ名, group="グループ変数名", focal.names=c("焦点群１","焦点群２",…)))
３つの分析結果の比較
genDichoDif(データ名, group="グループ変数名", focal.names=c("焦点群１","焦点群２",…),
method=c("GMH","genLogistic","genLord"), nrFocal=焦点群の数, model="IRTモデル名"))
データは，分析に用いる項目と，グループ変数だけからなる．
IRTモデル名： 1PL, 2PL, 3PL

カイ２乗値のプロット
plot(DIF分析オブジェクト名)
スケーリングした項目母数
群名 <- c("参照群名","焦点群１","焦点群２",…)
項目母数オブジェクト名 <- DIF分析オブジェクト名$itemParInit
rownames(項目母数オブジェクト名) <-NULL
items <- rep(DIF分析オブジェクト名$names, length(群名))group <- rep(群名, each=length(DIF分析オブジェクト名$names))(項目母数オブジェクト名 <- data.frame(items, 項目母数オブジェクト名, group))
項目特性曲線の描画
plot(DIF分析オブジェクト名, plot="itemCurve", item=変数番号, ref.name="参照群名")
itemは，"変数名"で指定してもよい> setwd("d:\\")> dAll <- read.table("DIF10.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(dAll)
1
2
3
4
5
6
>

Student.ID Age Group Gender Item1 Item2 Item3 Item4 Item5 Item6 Item7 Item8 Item9 Item10
1 14 Minhla female
1
1
1
0
0
1
0
0
0
0
1 14 Minhla female
1
1
1
1
1
1
1
1
1
1
2 14 Minhla
male
1
1
1
1
1
1
1
0
0
1
2 14 Minhla female
1
1
1
1
1
1
0
0
0
1
2 14 Minhla
male
1
1
1
1
1
1
1
1
1
1
3 14 Minhla
male
1
1
1
1
1
1
1
1
1
1>

> # dataset> dEth <- dAll[,c("Item1","Item2","Item3","Item4","Item5",+"Item6","Item7","Item8","Item9","Item10", "Group")]>498

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # DIF analysis>> library(difR)> # 2PL model, "ltm" engine>> # Lord chi-squares, p values, and DIF items> (rEth <- difGenLord(dEth, group="Group", focal.names=c("Sittway","Minhla"),+nrFocal=2, model="2PL"))
Detection of Differential Item Functioning using generalized Lord's method(2 focal groups), with 2PL model and without item purification
Engine 'ltm' for item parameter estimation
No set of anchor items was provided
No p-value adjustment for multiple comparisonsGeneralized Lord's chi-square statistic:Stat.
P-valueItem1
5.1485 0.2724
Item2
2.2867 0.6832
Item3
0.6843 0.9533
Item4
6.2871 0.1787
Item5
5.1120 0.2760
Item6
4.2367 0.3749
Item7
7.1024 0.1306
Item8
5.9109 0.2059
Item9 11.1676 0.0247 *Item10 5.9766 0.2009
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Detection threshold: 9.4877 (significance level: 0.05)
Items detected as DIF items:
Item9
Output was not captured!

> # plot of chi square statistics> plot(rEth)
The plot was not captured!
>499

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # M-H , p values, and DIF items> (rMHEth <- difGMH(dEth, group="Group", focal.name=c("Sittway","Minhla")))Detection of Differential Item Functioning using Generalized Mantel-Haenszel
method, without item purification and with 2 focal groups
Focal groups:
Sittway
MinhlaMatching variable: test score
No set of anchor items was provided
No p-value adjustment for multiple comparisonsGeneralized Mantel-Haenszel chi-square statistic:
Stat. P-value
Item1 3.3104 0.1911
Item2 3.5828 0.1667
Item3 0.0710 0.9651
Item4 1.3160 0.5179
Item5 1.7659 0.4136
Item6 7.8493 0.0197 *Item7 4.1496 0.1256
Item8 3.3832 0.1842
Item9 3.3504 0.1873
Item10 0.2418 0.8861
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Detection threshold: 5.9915 (significance level: 0.05)
Items detected as DIF items:
Item6
Output was not captured!

> # Logistic, p values, and DIF items> (rLogsEth <- difGenLogistic(dEth, group="Group", focal.name=c("Sittway","Minhla")))Detection of both types of Differential Item Functioning
using Generalized logistic regression method,
without item purification and with 2 focal groups
Focal groups:
Sittway
Minhla
DIF flagging criterion: Likelihood ratio test
Matching variable: test score
No set of anchor items was provided
No p-value adjustment for multiple comparisonsGeneralized Logistic regression statistic:500

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

Stat.
P-valueItem1
4.3921 0.3555
Item2
6.3923 0.1717
Item3
0.0854 0.9991
Item4
6.3593 0.1739
Item5 14.9842 0.0047 **Item6
9.3672 0.0525 .
Item7 12.6210 0.0133 *Item8 14.8718 0.0050 **Item9 11.9417 0.0178 *Item10 3.1416 0.5344
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Detection threshold: 9.4877 (significance level: 0.05)
Items detected as DIF items:
Item5
Item7
Item8
Item9
Effect size (Nagelkerke's R^2):
Effect size code:'A': negligible effect'B': moderate effect'C': large effect
R^2
ZT JG
Item1 0.0127 A A
Item2 0.0218 A A
Item3 0.0003 A A
Item4 0.0152 A A
Item5 0.0282 A A
Item6 0.0273 A A
Item7 0.0237 A A
Item8 0.0278 A A
Item9 0.0242 A A
Item10 0.0068 A A
Effect size codes:
Zumbo & Thomas (ZT): 0 'A' 0.13 'B' 0.26 'C' 1
Jodoin & Gierl (JG): 0 'A' 0.035 'B' 0.07 'C' 1
Output was not captured!

> # compare three results> (gEth <- genDichoDif(dEth, group="Group", focal.names=c("Sittway","Minhla"),+method=c("genLord","GMH","genLogistic"),+
nrFocal=2, model="2PL"))
Comparison of DIF detection among multiple groups, using 3 methods
Generalized methods used: Lord's chi-square test, Mantel-Haenszel,
Logistic regression
Matching variable: test score
No set of anchor items was provided
Parameters:
Significance level: 0.05
DIF effects tested by generalized logistic regression: both effects
501

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

DIF flagging criterion: Likelihood ratio test
Item response model: 2PL
Engine 'ltm' for item parameter estimation
Item purification: No
No p-value adjustment for multiple comparisonsComparison of DIF detection results:
Lord M.-H. Logistic #DIF
Item1 NoDIF NoDIF NoDIF
0/3
Item2 NoDIF NoDIF NoDIF
0/3
Item3 NoDIF NoDIF NoDIF
0/3
Item4 NoDIF NoDIF NoDIF
0/3
Item5 NoDIF NoDIF DIF
1/3
Item6 NoDIF DIF NoDIF
1/3
Item7 NoDIF NoDIF DIF
1/3
Item8 NoDIF NoDIF DIF
1/3
Item9
DIF NoDIF DIF
2/3
Item10 NoDIF NoDIF NoDIF
0/3
Output was not captured!
>>>> #all group values> agnEth<-c("Myitkyinar","Sittway","Minhla")>>>> # discriminant and difficulty parameters after rescalling> sIParEth <- rEth$itemParInit> rownames(sIParEth) <-NULL> items <- rep(rEth$names, length(agnEth))> group <- rep(agnEth, each=length(rEth$names))> (sIParEth <- data.frame(items, sIParEth, group))
items
a
b
se.a.
se.b.
cov.a.b.
group1
Item1 1.5380969 -1.83828193 0.4002920 0.3190842 0.109661508 Myitkyinar2
Item2 2.0400659 -2.27464886 0.6365087 0.3862125 0.212230661 Myitkyinar
3
Item3 1.8825491 -2.24371338 0.5673737 0.3887347 0.192006403 Myitkyinar
4
Item4 1.0259302 -2.07074036 0.2852980 0.4638368 0.119533785 Myitkyinar5
Item5 2.0394004 -1.03381906 0.4998997 0.1590402 0.054021960 Myitkyinar6
Item6 1.6522546 -2.14141890 0.4639729 0.3791613 0.154066185 Myitkyinar
7
Item7 1.6141457 -0.90759031 0.3687412 0.1647958 0.039987083 Myitkyinar8
Item8 1.4403277 -0.45802015 0.3197056 0.1367103 0.018433958 Myitkyinar
9
Item9 0.9098867 -0.10301649 0.2249735 0.1641164 0.004056429 Myitkyinar
10 Item10 0.3859422 -2.49122292 0.1874362 1.1941683 0.212574574 Myitkyinar
11 Item1 1.7485795 -2.07722535 0.6299268 0.2901455 0.087026849
Sittway
12 Item2 1.7896214 -2.00405041 0.6358558 0.2774932 0.075399445
Sittway
13 Item3 1.7366152 -2.36205236 0.6609115 0.3263546 0.122977902
Sittway
14 Item4 0.5252554 -2.32556132 0.2589588 0.7518019 0.144409051
Sittway
15 Item5 0.8503619 -1.66917263 0.3078722 0.3809860 0.050556450
Sittway
16 Item6 1.5452392 -2.50287354 0.5916726 0.3732614 0.142267478
Sittway
17 Item7 0.6821572 -0.86888040 0.2746271 0.3949254 -0.009275056
Sittway
18 Item8 0.7549751 -0.53868432 0.2879522 0.3872646 -0.034494214
Sittway
19 Item9 1.4346514 -0.04610927 0.5215074 0.3088151 -0.079355050
Sittway
20 Item10 1.0869772 -1.16786276 0.3611431 0.2927724 0.011058320
Sittway
21 Item1 1.4715802 -2.48778654 0.4395723 0.3773747 0.136199019
Minhla22 Item2 4.0055900 -2.22321350 2.8993142 0.2457029 0.526190461
Minhla23 Item3 1.4974351 -2.69569898 0.4888017 0.4433817 0.185256331
Minhla24 Item4 1.2258118 -1.68406363 0.3235524 0.2642452 0.059505427
Minhla25 Item5 1.5558869 -1.16685236 0.4192775 0.1804287 0.036124026
Minhla26 Item6 1.0678651 -2.22144101 0.3130277 0.4000075 0.103828799
Minhla27 Item7 0.7816893 -0.74675965 0.2257378 0.2377531 0.013165136
Minhla28 Item8 0.6073449 -1.06547986 0.2036376 0.3266552 0.033399361
Minhla29 Item9 0.2157375 -0.02383844 0.1708070 0.7936706 -0.057566944
Minhla30 Item10 1.0188381 -1.24733840 0.2809263 0.2402838 0.038081481
Minhla>502# SE大きいので見警告# SE大きいので見警告名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>> #draw ICCs
> par(mfrow=c(3,3))> plot(rEth, plot="itemCurve", item="Item2", ref.name="Myitkyinar")> plot(rEth, plot="itemCurve", item="Item5", ref.name="Myitkyinar")> plot(rEth, plot="itemCurve", item="Item6", ref.name="Myitkyinar")> plot(rEth, plot="itemCurve", item="Item7", ref.name="Myitkyinar")> plot(rEth, plot="itemCurve", item="Item8", ref.name="Myitkyinar")> plot(rEth, plot="itemCurve", item="Item9", ref.name="Myitkyinar")> plot(rEth, plot="itemCurve", item="Item10", ref.name="Myitkyinar")
The plot was not captured!
> par(mfrow=c(1,1))
>
>

503

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

文字列関数 ― 文字列の切り出し・結合・検索・置換
切り出し
substr(対象変数名，始点, 終点)
始点，終点で，要素の何文字目から何文字目までを切り出すかを指定する
結合
paste(文字列の指定，sep="区切りの指定")
paste0(文字列の指定)
paste(ベクトル, collapse="区切りの指定")
sep="," でカンマ区切り，sep="" で区切りなし．sep= を省略すると半角スペース区切りになる。
paste0 は，sep="" と指定したことと同じになる。
ベクトルの要素をつなげるときは，collapseを入れる。""の間に何も書かないとベタづけになる。
検索
grep("検索する文字列", 検索対象, fixed = FALSE)
grepl("検索する文字列", 検索対象, fixed = FALSE)
regexpr("検索する文字列", 検索対象, fixed = FALSE)
gregexpr("検索する文字列", 検索対象, fixed = FALSE)
grep：
検索する文字列があったところの要素番号を返す．
grepl：
検索する文字列があるかどうか，すべての要素について TRUE, FALSE で返す．
regexpr： 検索する文字列があれば，初出のもののみそれが何文字目かの値，なければ-1を返す．
gregexpr：検索する文字列が複数あればそれがそれぞれ何文字目かの値，なければ-1を返す．
置換
sub("検索する文字列", "置き換える文字列", 検索対象, fixed = FALSE)
gsub("検索する文字列", "置き換える文字列", 検索対象, fixed = FALSE)
sub： 置換したい文字列があれば，初出のもののみ置換する．
gsub：置換したい文字列が複数あれば，それがそれらすべてを置換する．
【注】
fixed=TRUE とすると完全一致のみ評価．カタカナや特殊記号を含む文字列を評価する場合，fixed=FALSE
か fixed=TRUE の指定をしておかないとエラーになることがある．

> setwd("i:\\Rdocuments\\scripts\\")> d1 <- read.table("文字列_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1
idcourse
1 1
行動
2 2
臨床
3 3
行動コース
4 4
臨床コース
5 5
コース行動
6 6
コース臨床
7 7 行動行動コース
8 8 臨床臨床コース>504

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 文字列の切り出し> d1$course1 <- substr(d1$course,1,3)> d1
idcourse course1
1 1
行動
行動
2 2
臨床
臨床
3 3
行動コース 行動コ
4 4
臨床コース 臨床コ
5 5コース行動 コース
6 6
コース臨床 コース
7 7 行動行動コース 行動行
8 8 臨床臨床コース 臨床臨> # 文字列の結合> d1$course2 <- paste("心理", d1$course)> d1$course3 <- paste("心理", d1$course, sep="")> d1
id
course course1
course2
course3
1 1
行動
行動
心理 行動
心理行動
2 2
臨床
臨床
心理 臨床
心理臨床
3 3
行動コース 行動コ
心理 行動コース
心理行動コース
4 4臨床コース 臨床コ
心理 臨床コース
心理臨床コース
5 5
コース行動 コース
心理 コース行動心理コース行動6 6
コース臨床 コース
心理 コース臨床心理コース臨床7 7 行動行動コース 行動行 心理 行動行動コース 心理行動行動コース
8 8 臨床臨床コース 臨床臨 心理 臨床臨床コース 心理臨床臨床>>> # course2 は半角スペース区切り，course3 は区切りなしで， "心理" が結合されている．

> # ベクトルの要素の結合> vitem <- c("x1","x2")> nitem <- paste(vitem, collapse=",")> vitem[1] "x1" "x2"
> nitem[1] "x1,x2"> data <- matrix(c(1,1, 1,0, 0,1, 0,0), nrow=4, ncol=2, byrow=TRUE)> data[,1] [,2]
[1,]
1
1
[2,]
1
0
[3,]
0
1
[4,]
0
0
>
> paste(data, collapse="")[1] "11001010">> apply(data, 1, paste, collapse="")[1] "11" "10" "01" "00">> apply(data, 2, paste, collapse="")[1] "1100" "1010"
>
>

505

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 文字列の検索> grep("行動", d1$course, fixed = FALSE)[1] 1 3 5 7# "行動"を含む行番号を表示> grepl("行動", d1$course, fixed = FALSE)[1] TRUE FALSE TRUE FALSE TRUE FALSE TRUE FALSE# 各行が"行動"を含むかどうかを表示> regexpr("行動", d1$course, fixed = FALSE)[1] 1 -1 1 -1 4 -1 1 -1
attr(,"match.length")[1] 2 -1 2 -1 2 -1 2 -1

# "行動"を含めばそれが何文字目か，# 含まなければ-1を表示> gregexpr("行動", d1$course, fixed = FALSE)
[[1]]
[1] 1
attr(,"match.length")[1] 2# "行動"を複数含めばそれぞれ何文字目か，# 含まなければ-1を表示

# 中略
[[6]]
[1] -1attr(,"match.length")[1] -1[[7]][1] 1 3attr(,"match.length")[1] 2 2[[8]]
[1] -1attr(,"match.length")[1] -1>> # 文字列の置換> sub("行動", "教心",d1$course, fixed = FALSE)[1] "教心""臨床""教心コース""臨床コース"[5] "コース教心""コース臨床""教心行動コース" "臨床臨床コース"# 同一要素内の１つめの"行動"は"教心"に置換されるが，それ以降のものは置換されない．

> gsub("行動", "教心",d1$course, fixed = FALSE)[1] "教心""臨床""教心コース""臨床コース"[5] "コース教心""コース臨床""教心教心コース" "臨床臨床コース"># 同一要素内のすべての"行動"が"教心"に置換される．

506

名古屋 大学
演算記号・算術関数> x <- 5> y <- 2>> # 和> x + y
[1] 7
>
> # 差
> x - y
[1] 3
>
> # 積
> x * y[1] 10>> # 除算> x / y[1] 2.5>> # 商> x %/% y[1] 2>> # 余り> x %% y[1] 1>> # べき乗> x^y[1] 25>> # 平方根> sqrt(x)[1] 2.236068>> # 指数> exp(x)[1] 148.4132>> # 自然対数> log(x)[1] 1.609438>> # 三角関数> sin(x)[1] -0.9589243> cos(x)[1] 0.2836622> tan(x)[1] -3.380515> u <- 0.5> asin(u)[1] 0.5235988
507

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学> acos(u)[1] 1.047198> atan(u)[1] 0.4636476>>> # 最大値・最小値> a <- c(1,3,2,5,4)> max(a)[1] 5> min(a)[1] 1>> # 最大値・最小値の要素番号> which.max(a)[1] 4> which.min(a)[1] 1>> # 異なるベクトルの同じ位置にある要素の最大値・最小値> b <- c(2,4,4,4,3)> pmax(a,b)[1] 2 4 4 5 4> pmin(a,b)[1] 1 3 2 4 3
>
>

508

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

切り上げ・切り下げ・四捨五入> a <- 2.525> b <- 2.515> c <- -2.515> d <- -2.525>>> # 切り上げ，Xを超える最小の整数値> ceiling(a)[1] 3> ceiling(b)[1] 3> ceiling(c)[1] -2> ceiling(d)[1] -2>>> # 切り下げ，Xを超えない最小の整数値> floor(a)[1] 2> floor(b)[1] 2> floor(c)[1] -3> floor(d)[1] -3>> # Xの小数点以下を削除> trunc(a)[1] 2> trunc(b)[1] 2> trunc(c)[1] -2> trunc(d)[1] -2>>> # 四捨五入．ただし，X.5はXが偶数ならX，Xが奇数ならX+1に変換> # round(x,p) x:数値，p：小数点以下桁数>> p <- 2> round(a, p)[1] 2.52> rround(b, p)[1] 2.52> round(c, p)[1] -2.52> round(d, p)[1] -2.52>>> # 通常の四捨五入> p <- 2> sign(a)*floor(abs(a)*10^p + 0.5)/10^p[1] 2.53> sign(b)*floor(abs(b)*10^p + 0.5)/10^p[1] 2.52> sign(c)*floor(abs(c)*10^p + 0.5)/10^p[1] -2.52> sign(d)*floor(abs(d)*10^p + 0.5)/10^p[1] -2.53>
509

名古屋 大学>> # ＋方向に四捨五入> p <- 2> floor(a*10^p + 0.5)/10^p[1] 2.53> floor(b*10^p + 0.5)/10^p[1] 2.52> floor(c*10^p + 0.5)/10^p[1] -2.51> floor(d*10^p + 0.5)/10^p[1] -2.52>>

510

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学
集合関数> x <- c("a","c","e")> y <- c("a","b","c","d")>> # 和集合> (z <- union(x,y))[1] "a" "c" "e" "b" "d">> # 積集合> (z <- intersect(x,y))[1] "a" "c">> # xの要素のうち，yに含まれるものを除いた集合> (z <- setdiff(x,y))[1] "e">> # xの各要素はyの要素であるか> (z <- is.element(x,y))[1] TRUE TRUE FALSE> (z <- x %in% y)[1] TRUE TRUE FALSE>> # 集合として等しいか> (z <- setequal(x,y))[1] FALSE> w <- c("a","c","e","a","c","e")> (z <- setequal(x,w))[1] TRUE>>

511

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学
比較演算子> x <- 5> y <- 5> z <- 5.00000001>> w <- NA>> t <- c(1,1,1)> u <- c(2,2,2)> v <- c(1,2,3)>>> # 比較演算子>> # 等しいか> x == y[1] TRUE> identical(x,y)[1] TRUE> identical(x,z)[1] FALSE>> # ほとんど等しいか> all.equal(x,z)[1] TRUE>> # 等しくないか> x != y[1] FALSE>> # 以上か> x >= y[1] TRUE>> # 超か> x > y[1] FALSE>> # 以下か> x <= y[1] TRUE>> # 未満か> x < y[1] FALSE>>> # 欠測値か> is.na(w)[1] TRUE
>
>
>

512

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学
論理演算子> x <- 5> y <- 5> z <- 5.00000001>> w <- NA>> t <- c(1,1,1)> u <- c(2,2,2)> v <- c(1,2,3)>>> # 論理演算子>> # かつ(スカラー> (x==5) && (y==4)[1] FALSE> # または(スカラー)> (x==5) || (y==4)[1] TRUE> # かつ(ベクトル)> # if文でベクトルを評価した場合は，先頭要素の真偽で判> (t==v) & (u==v)[1] FALSE FALSE FALSE> # または(ベクトル)> # if文でベクトルを評価した場合は，先頭要素の真偽で判> (t==v) | (u==v)[1] TRUE TRUE FALSE>> # でない> !(x==4)[1] TRUE> !(u==v)[1] TRUE FALSE>> !(v==2)[1] TRUE FALSE

TRUE
TRUE

513

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学
ベクトルの生成
> # ベクトルの生成> (x <- c(1,4,3))[1] 1 4 3
> (y <- c(2,6,8))[1] 2 6 8>>
> # ベクトルの連結> (z <- c(x,y))[1] 1 4 3 2 6 8> # 値が1ずつ増えていくベクトル> (x <- c(1:9))[1] 1 2 3 4 5 6 7 8 9> (x <- seq(1,9))[1] 1 2 3 4 5 6 7 8 9> # ベクトルを逆順にする> (y <- rev(x))[1] 9 8 7 6 5 4 3 2 1> # 指定した値ずつ増えていくベクトル> (x <- seq(1,9,by=2))[1] 1 3 5 7 9> # 同一ベクトルを指定個つなげる> (x <- rep(c("a","b","c"),2))[1] "a" "b" "c" "a" "b" "c"> # 各要素を指定回繰り返す> (x <- rep(c("a","b","c"),each=2))[1] "a" "a" "b" "b" "c" "c"> # 重複要素のあるベクトルから素な要素だけを抽出する> unique(x)[1] "a" "b" "c"514

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

ベクトルの要素の評価> # ベクトル1の各要素が，ベクトル2のいずれかの要素であるか否かを返す> c(1:6) %in% c(1,4,5)[1] TRUE FALSE FALSE TRUE TRUE FALSE> # ベクトル1の要素が，ベクトル2に初めて出てくる要素番号を返す> match(c(1), 1:10 )[1] 1> # ベクトル1の要素を含む，ベクトル2の要素番号をすべて返す> grep(c(1), 1:10 )[1] 1 10

> # 文字データの長さを返す> nchar(c("a","bcd","ef"))[1] 1 3 2

> # ベクトル1の各要素を含む，ベクトル2の要素が1つであるとき，その要素番号を返す> # 完全一致が部分一致に優先される> # 一致する部分がなかったり，複数一致する場合は0を返す> charmatch("m",[1] 0c("mean", "median", "mode"))> charmatch("med", c("mean", "median", "mode"))[1] 2> charmatch(c("", "ab", "ab"), c("abc", "ab"))[1] 0 2 2

> # ベクトル1の各要素を含む，ベクトル2の要素が1つであるとき，その要素番号を返す> # 完全一致が部分一致に優先される> #dup=F とすると，一度match された要素は除外される> # 一致する部分がなかったり，複数一致する場合はNAを返す> pmatch("m",[1] NAc("mean", "median", "mode"))> pmatch("med", c("mean", "median", "mode"))[1] 2> pmatch(c("", "ab", "ab"), c("abc", "ab"), dup = FALSE)[1] NA 2 1> pmatch(c("", "ab", "ab"), c("abc", "ab"), dup = TRUE)[1] NA 2 2> # 条件を満たすベクトル，行列の要素の要素番号を返す> (vodd <- seq(1,19,2))[1] 1 3 5 7 9 11 13 15 17 19> # 要素番号> which(vodd>5)[1] 4 5 6 7

8

9 10

> # その要素番号の値> vodd[which(vodd>5)][1] 7 9 11 13 15 17 19515

名古屋 大学>> # こうしても同じ> vodd[(vodd>5)][1] 7 9 11 13 15 17 19> # 行列の場合> (mnum <- matrix(c(1:15),nrow=3,ncol=5, byrow=T))[,1] [,2] [,3] [,4] [,5]
[1,]
1
2
3
4
5
[2,]
6
7
8
9
10
[3,]
11
12
13
14
15
>
> # 行列のベクトル表現> as.vector(mnum)[1] 1 6 11 2 7 12
>

3

8 13

4

9 14

5 10 15> # 条件（3で割り切れる）を満たす要素のベクトル要素番号> which(mnum %% 3==0)[1] 2 6 7 11 15>> # 条件（3で割り切れる）を満たす要素の行列要素番号> which(mnum %% 3==0, arr.ind=T)
row col
[1,]
2
1
[2,]
3
2
[3,]
1
3
[4,]
2
4
[5,]
3
5
>
> # 条件（3で割り切れる）を満たす要素の値> mnum[which(mnum %% 3==0)][1] 6 12 3 9 15

> # こうしても同じ> mnum[(mnum %%3==0)][1] 6 12 3 9 15516

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

行列演算> # 行列の生成> # データフレームを行列に変える> d1 <- read.table("制御_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)x1 x2 x3
1 NA 3 2
2 3 3 23 1 3 24 3 3 25 3 3 36 3 3 2>
> x <- as.matrix(d1)> head(x)x1 x2 x3
[1,] NA 3 2[2,] 3 3 2[3,] 1 3 2[4,] 3 3 2[5,] 3 3 3[6,] 3 3 2> # 要素を入力して行列を作成する> (x <- matrix(c(
+
1,2,
+
3,4,
+
5,6), 3, 2, byrow=T))[,1] [,2]
[1,]
1
2
[2,]
3
4
[3,]
5
6
>
> (y <- matrix(c(
+
1,1,
+
0,1,
+
1,0), 3,2, byrow=T))[,1] [,2]
[1,]
1
1
[2,]
0
1
[3,]
1
0
> # 単位行列> diag(3)[,1] [,2] [,3]
[1,]
1
0
0
[2,]
0
1
0
[3,]
0
0
1
>
> # 行列の転置> t(x)[,1] [,2] [,3]
[1,]
1
3
5
[2,]
2
4
6
>
> # 行列の足し算> (x+y)[,1] [,2]
[1,]
2
3
[2,]
3
5
[3,]
6
6
>

517

名古屋 大学> # 行列の引き算> (x-y)[,1] [,2]
[1,]
0
1
[2,]
3
3
[3,]
4
6
>
> # 要素の2乗> x^2[,1] [,2]
[1,]
1
4
[2,]
9
16
[3,]
25
36
> # 行列のかけ算> (z <- t(x) %*% y)[,1] [,2]
[1,]
6
4
[2,]
8
6
> (w <- x %*% t(y))[,1] [,2] [,3]
[1,]
3
2
1
[2,]
7
4
3
[3,]
11
6
5
>
> # クロネッカー積> x %x% y[,1] [,2] [,3] [,4]
[1,]
1
1
2
2
[2,]
0
1
0
2
[3,]
1
0
2
0
[4,]
3
3
4
4
[5,]
0
3
0
4
[6,]
3
0
4
0
[7,]
5
5
6
6
[8,]
0
5
0
6
[9,]
5
0
6
0
> # 対角行列> diag(c(1,2,3))[,1] [,2] [,3]
[1,]
1
0
0
[2,]
0
2
0
[3,]
0
0
3
>
> # 対角要素の取り出し> diag(w)[1] 3 4 5>
> # 対角要素だけを残した行列の作成> diag(diag(w))[,1] [,2] [,3]
[1,]
3
0
0
[2,]
0
4
0
[3,]
0
0
5
>

518

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学> # 三角行列> u <- v <- w
> u[lower.tri(u)] <- 0
> v[upper.tri(v)] <- 0
> u
[1,]
[2,]
[3,]

[,1] [,2] [,3]
3
2
1
0
4
3
0
0
5

> v
[1,]
[2,]
[3,]
>

[,1] [,2] [,3]
3
0
0
7
4
0
11
6
5

> # 行列式> det(z)[1] 4> det(w)[1] -4.440892e-16> round(det(w),4)[1] 0>> # 逆行列> (invz <- solve(z))[,1] [,2][1,] 1.5 -1.0
[2,] -2.0 1.5> # 一般逆行列> library(MASS)> (ginv(w))
[,1]
[,2]
[,3]
[1,] -0.08333333 8.257284e-16 0.08333333[2,] 1.16666667 3.333333e-01 -0.50000000[3,] -1.25000000 -3.333333e-01 0.58333333>> # 固有値分解> eigen(z)$values[1] 11.6568542

0.3431458$vectors[,1][,2][1,] 0.5773503 -0.5773503[2,] 0.8164966 0.8164966>> # 特異値分解> svd(x)$d[1] 9.5255181 0.5143006
$u
[,1]
[,2]
[1,] -0.2298477 0.8834610[2,] -0.5247448 0.2407825[3,] -0.8196419 -0.4018960
$v
[,1]
[,2]
[1,] -0.6196295 -0.7848945[2,] -0.7848945 0.6196295
519

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学> # QR分解> qr(x)
$qr

[,1]
[,2]
[1,] -5.9160798 -7.4373574[2,] 0.5070926 0.8280787[3,] 0.8451543 0.9935832
$rank
[1] 2
$qraux[1] 1.169031 1.113104$pivot[1] 1 2attr(,"class")[1] "qr">> # コレスキー分解> chol(z)[,1][,2][1,] 2.44949 1.632993[2,] 0.00000 1.825742> chol(w)
[,1]
[,2]
[,3]
[1,] 1.732051 1.154701 0.5773503[2,] 0.000000 1.632993 1.4288690[3,] 0.000000 0.000000 1.6201852

520

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

制御コマンド評価する条件式に NA が入るとエラーになってしまうので，is.na(変数名) などとして，NAであればTRUE,
NAでなければFALSEを返すように，まずしておくとよい．

for(ループ変数 in 値を変化させる範囲){
ループ変数の値の変化に伴い実行される式の群}

if (条件式1) { 条件式1がTRUEの時に実行される式の群 }if (条件式1) {条件式1がTRUEの時に実行される式の群} else if (条件式2) {条件式1がFALSEで，条件式2がTRUEの時に実行される式の群} else{ 以上の条件式がすべてFALSEのときに実行される式の群}実行される式が1つであれば{}で囲わなくてもよい．
}とelseの間で改行しないほうがよい。
else if 以下は省略することができる．
if ((条件式1a) & (条件式1b)) とすれば，条件式1a および 条件式1bの両方がTRUEの場合，となる
if ((条件式1a) | (条件式1b)) とすれば，条件式1a または 条件式1bの一方がTRUEの場合，となる

ifelse(ある変数についての条件式, 条件式がTRUEの時の当該変数の値，条件式がFALSEの時の当該変数の値)

while(条件式){
実行される式の群}
式を実行する前に条件式の評価を行い，条件式がTRUEである間，式を実行する．
条件式が常にTRUEであれば，いつまでも関数が動いてしまうので注意．

repeat{実行される式の群
if(条件式) break}
式を実行した後に条件式の評価を行い，条件式がTRUEになれば終了する．
if(条件式) break を入れるのを忘れない．

breakfor, while, repeat などのループから強制的に抜け出すコマンド．

> setwd("d:\\")> d1 <- read.table("制御_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> d1
x1 x2 x3
1 NA 3 2
2
3 3 2
3
1 3 2
4
3 3 2
5
3 3 3
6
3 3 2
7
2 3 3
8
2 3 2
9
3 3 2
521

名古屋 大学
10 2 3
11 1 3
12 3 3
13 1 314 2 315 NA NA>

大 学院 教育発 達科 学研 究科・ 教育 学部

2
2
2
3
2
2

> # d1の行数> nr <- nrow(d1)>> # d1の変数名> cnames1 <- colnames(d1)>> # d1の行数，2列，要素の値0の行列を生成> d2 <- matrix(c(0),nr,2)>> # d1とd2を結合> d1 <- data.frame(d1,d2)> colnames(d1) <- c(cnames1, "s1","m1")> d1
x1 x2 x3 s1 m1
1 NA 3 2 0 02
3 3 2 0 03
1 3 2 0 04
3 3 2 0 05
3 3 3 0 0
6
3 3 2 0 07
2 3 3 0 08
2 3 2 0 0
9
3 3 2 0 0
10 2 3 2 0 0
11 1 3 2 0 0
12 3 3 2 0 0
13 1 3 3 0 0
14 2 3 2 0 0
15 NA NA 2 0 0>> #for, if> for (i in 1 : nr){
+ if (is.na(d1$x1[i])!=TRUE){+
if (d1$x1[i]==1) d1$s1[i] <- 0.5+
if (d1$x1[i]==2) d1$s1[i] <- 1+
d1$s1[i] <- 0+ } else {+d1$s1[i] <- 0+
d1$m1[i] <- 1
+ }
+ }
> d1
x1 x2 x3 s1 m1
1 NA 3 2 0.0 12
3 3 2 0.0 03
1 3 2 0.5 0
4
3 3 2 0.0 05
3 3 3 0.0 0
6
3 3 2 0.0 07
2 3 3 1.0 0
8
2 3 2 1.0 0
9
3 3 2 0.0 0
10 2 3 2 1.0 0
11 1 3 2 0.5 0
12 3 3 2 0.0 0
13 1 3 3 0.5 0
14 2 3 2 1.0 0
15 NA NA 2 0.0 1

else
else

# iを1からnrまで変化させる# x1が欠測でなければ，# x1が1ならs1を0.5とする# x1が2ならs1を1とする# x1がそれ以外なら，s1を0とする# x1が欠測値なら，s1を0とし，# さらに，m1を10とする

522

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>>> # ifelse> ifelse(d1$x3==2, 1, 0)[1] 1 1 1 1 0 1 0 1 1 1 1 1 0 1 1>> # while> j <- 1> while(j <= 10){+ print(d1[j,])+ j <- j+1+ }x1 x2 x3 s1 m1
1 NA 3 2 0 1x1 x2 x3 s1 m1
2 3 3 2 0 0x1 x2 x3 s1 m1
3 1 3 2 0.5 0x1 x2 x3 s1 m1
4 3 3 2 0 0x1 x2 x3 s1 m1
5 3 3 3 0 0x1 x2 x3 s1 m1
6 3 3 2 0 0x1 x2 x3 s1 m1
7 2 3 3 1 0x1 x2 x3 s1 m1
8 2 3 2 1 0x1 x2 x3 s1 m1
9 3 3 2 0 0x1 x2 x3 s1 m1
10 2 3 2 1 0>> # repeat> k <- 1> repeat{+ print(d1[k,])+ k <- k+1+ if (k > 8) break+ }x1 x2 x3 s1 m1
1 NA 3 2 0 1x1 x2 x3 s1 m1
2 3 3 2 0 0x1 x2 x3 s1 m1
3 1 3 2 0.5 0x1 x2 x3 s1 m1
4 3 3 2 0 0x1 x2 x3 s1 m1
5 3 3 3 0 0x1 x2 x3 s1 m1
6 3 3 2 0 0x1 x2 x3 s1 m1
7 2 3 3 1 0x1 x2 x3 s1 m1
8 2 3 2 1 0># x3が2なら１，それ以外なら0を表示# はじめにjの値を1と指定# jが10以下である間は次を繰り返す# d1の第j行を表示# jの値を1だけ増加させる# はじめにkの値を1と指定# d1の第k行を表示# kの値を1だけ増加させる# もしkが8を超えたら終了．そうでなければ上を繰り返す

523

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

コマンドを生成して実行
eval(parse(text=paste(コマンド文を生成する指定, sep="")))
for文で，iやjの値を変数の指定に用いて，コマンドを生成して実行するのに用いることも多い．

> x <- 2> y <- 4>>> # x,yを数値として扱うか，"文字"として扱うかで paste の結果が異なる>> # xの値とyの値をpaste> paste(x, y, sep="")[1] "24">> # x+yの値> paste(x+y, sep="")[1] "6">> # xの値とyの値を足す式> paste(x,"+",y, sep="")[1] "2+4">> # xとyを足す式> paste("x+y", sep="")[1] "x+y">>> # pasteされたものをスクリプトとして実行する>> eval(parse(text=paste(x, y, sep="")))[1] 24>> eval(parse(text=paste(x+y, sep="")))[1] 6>> eveval(parse(text=paste(x,"+",y, sep="")))[1] 6>> eval(parse(text=paste("x+y", sep="")))
[1] 6
>
>

524

名古屋 大学> # ベクトルがある場合> z <- c(1,3)>> # xとzの各要素をそれぞれpasteした値のベクトル> paste(x, z, sep="")[1] "21" "23">> # xとzの各要素をそれぞれ足した値のベクトル> paste(x+z, sep="")[1] "3" "5">> # xとzの要素の値をそれぞれ足す式> paste(x,"+",z, sep="")[1] "2+1" "2+3">> # xとzを足す式> paste("x+z", sep="")[1] "x+z">>> # pasteされたものをスクリプトとして実行する>> eval(parse(text=paste(x, z, sep="")))[1] 23>> eval(parse(text=paste(x+z, sep="")))[1] 5>> eval(parse(text=paste(x,"+",z, sep="")))[1] 5>> eeval(parse(text=paste("x+z", sep="")))[1] 3 5>>> # zの要素を結合した文字データ> (zz <- paste(z, collapse=""))[1] "13">> # xとzの要素をすべてpaste> paste(x, zz, sep="")[1] "213">> # xは数値，zは文字なので，足せない> paste(x+zz, sep="")x + zz でエラー: 二項演算子の引数が数値ではありません>> # xの値とzの値を足す式> pastex,"+",zz, sep="")[1] "2+13">> # xとzzと足す式> ppaste("x+zz", sep="")[1] "x+zz">>> # pasteされたものをスクリプトとして実行する>> eval(parse(text=paste(x, zz, sep="")))[1] 213>> eval(parse(text=paste(x+zz, sep="")))
x + zz でエラー: 二項演算子の引数が数値ではありません>> eval(parse(text=paste(x,"+",zz, sep="")))[1] 15>> eval(parse(text=paste("x+zz", sep="")))
x + zz でエラー: 二項演算子の引数が数値ではありません>
525

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学>>> # zの要素を結合した文字データを数値化> (zz <- as.numeric(paste(z, collapse="")))[1] 13>> # xとzの要素をすべてpaste> ppaste(x, zz, sep="")[1] "213">> # xとzzの値を足したもの> paste(x+zz, sep=""[1] "15">> # xとzzの値を足す式> paste(x,"+",zz, sep="")[1] "2+13">> # xとzzを足す式> paste("x+zz", sep="")[1] "x+zz">> # pasteされたものをスクリプトとして実行する>> eval(parse(text=paste(x, zz, sep="")))[1] 213> eval(parse(text=paste(x+zz, sep="")))[1] 15> eval(parse(text=paste(x,"+",zz, sep="")))[1] 15> eval(parse(text=paste("x+zz", sep="")))[1] 15
>
>
>
>

526

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

一括分析・総当たりの分析
分析に含める変数名を書いたベクトルの作成
ベクトル名 <- c(変数名の列)
一括分析・総当たりの分析
for(i in ベクトル名){
オブジェクト名 <- eval(parse(text=paste(分析関数や変数の設定, sep="")))
print(変数, quote = FALSE)
print(オブジェクト名)}
対応のある変数の総当たりの分析の場合は，for文を二重にして，iとjで回す．

> setwd("d:\\")> d1 <- read.table("総当たりの分析_データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)id class x1 x2 x3
1 1
a 3 3 22 2
a 3 3 23 3
a 3 3 24 4
a 3 3 25 5
b 3 3 36 6
a 3 3 2>
> # 分析に用いる変数名> v.names <- c("x1","x2","x3")>> # 各群の記述統計量> dtmp <- d1[d1$class=="a", v.names]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSDx1x2x3x1 43 2.53 0.55 1.00 0.37 0.55
x2 43 2.84 0.43 0.37 1.00 0.20
x3 43 2.16 0.57 0.55 0.20 1.00>
> dtmp <- d1[d1$class=="b", v.names]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSDx1x2x3x1 43 2.21 0.67 1.00 0.61 0.34
x2 43 2.44 0.70 0.61 1.00 0.40
x3 43 2.19 0.55 0.34 0.40 1.00

527

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 一括分析 － 対応のないｔ検定を指定したすべての変数について行う
for(i in v.names){tmp <- eval(parse(text=paste("t.test(d1$",i, "~d1$class, paired=FALSE)",sep="")))
print(i, quote = FALSE)
print(tmp)}[1] x1
Welch Two Sample t-test
data: d1$x1 by d1$classt = 2.4531, df = 80.715, p-value = 0.01632
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
0.06148781 0.58967498
sample estimates:
mean in group a mean in group b
2.534884
2.209302[1] x2
Welch Two Sample t-test
data: d1$x2 by d1$classt = 3.1491, df = 69.974, p-value = 0.002409
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
0.1449566 0.6457410
sample estimates:
mean in group a mean in group b
2.837209
2.441860[1] x3
Welch Two Sample t-test
data: d1$x3 by d1$classt = -0.1925, df = 83.781, p-value = 0.8479
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:-0.2635701 0.2170585
sample estimates:
mean in group a mean in group b
2.162791
2.186047> # 総当たりの分析 － 無相関検定を指定した変数においてすべての組合せについて行う> # 分析に用いる変数名> v.names <- c("x1","x2","x3")> # 記述統計量> dtmp <- d1[, v.names]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSDx1x2x3x1 86 2.37 0.63 1.00 0.56 0.41
x2 86 2.64 0.61 0.56 1.00 0.29
x3 86 2.17 0.56 0.41 0.29 1.00
528

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部>>> # 無相関検定を総当たりで行う> p <- length(v.names)> for(i in 1:(p-1)){+ for(j in (i+1):p){+
tmp <- eval(parse(text=paste("cor.test(d1$",v.names[i], ",d1$",v.names[j],+",use='paired.complete.obs')",sep="")))+
tcomp <- paste(v.names[i], "and", v.names[j])+print(tcomp, quote = FALSE)+
print(tmp)+ }+ }[1] x1 and x2
Pearson's product-moment correlation
data: d1$x1 and d1$x2
t = 6.2385, df = 84, p-value = 1.713e-08
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
0.3982996 0.6920578
sample estimates:cor
0.5626897[1] x1 and x3
Pearson's product-moment correlation
data: d1$x1 and d1$x3
t = 4.1692, df = 84, p-value = 7.397e-05
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
0.2216375 0.5754582
sample estimates:cor
0.4140683[1] x2 and x3
Pearson's product-moment correlation
data: d1$x2 and d1$x3
t = 2.7785, df = 84, p-value = 0.006735
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
0.08337366 0.47292836
sample estimates:cor
0.290124>529

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

関数の作成
関数名 <- function(引数，デフォルト値の設定){…
return(出力をまとめたもの)}
関数を使用するには，Rを立ち上げた後に，関数部分を一度実行しておく
関数の中で生成した値を関数の外でも使いたい場合
オブジェクト名 <<- 計算式

２群の平均値差の効果量を推定する関数# --------------------------------------------------------------# Effect Size deffectD <- function(n1, n2, m1, m2, s1, s2, conf.level=0.95){
library(MBESS)
esdf <- n1+n2-2
ess <- sqrt((n1*s1*s1 + n2*s2*s2)/esdf)
esg <- (m1-m2)/ess
esn <- sqrt(n1*n2/(n1+n2))
est <- esg*esn
escl <- conf.limits.nct(t.value=est, df=esdf, conf.level=conf.level)
eslow <- escl$Lower.Limit/esn
esup <- escl$Upper.Limit/esn
op <- round(c(esg, eslow, esup),2)
esout <- round(c(n1, n2, m1, m2, s1, s2, op),2)
names(esout) <- c("n1", "n2", "m1", "m2", "s1", "s2", "G", "Lower", "Upper")return(esout)detach("package:MBESS")}# ---------------------------------------------------------------> setwd("d:\\")> d1 <- read.table("対応のない2群の平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")>>> # 各群のデータを抽出> data1 <- d1[d1$説明=="ビデオ", "不安"]> data2 <- d1[d1$説明=="看護師", "不安"]> # 記述統計量> (m1 <- mean(data1))[1] 27.03883> (s1 <- sd(data1))[1] 4.315777> (n1 <- length(data1))[1] 103> (m2 <- mean(data2))[1] 25.43617> (s2 <- sd(data2))[1] 6.220947> (n2 <- length(data2))[1] 94> # 関数の実行> effectD(n1=n1, n2=n2, m1=m1, m2=m2, s1=s1, s2=s2)
n1103.00

n2
94.00

m1
27.04

m2
25.44

s1
4.32

s2
6.22

G
0.30

Lower
0.02

530

Upper
0.58

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

スクリプトの呼び出し
別ファイルに保存してあるスクリプトを呼び出して実行する。
source("ファイル名")
ディレクトリが異なる場合はディレクトリから指定する。
自作関数を別ファイルにして保存しておき，source を使って，必要な箇所でそのファイル（関数）を呼び出すという使い方ができる。

> setwd("i:\\Rdocuments\\scripts\\")>> d1 <- read.table("対応のない2群の平均値データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
番号
説明 不安
1
1 ビデオ
26
2
2 看護師
24
3
3 ビデオ
29
4
4 看護師
23
5
5 ビデオ
25
6
6 看護師
23
>
>
>
> # 各群のデータを抽出> data1 <- d1[d1$説明=="ビデオ", "不安"]> data2 <- d1[d1$説明=="看護師", "不安"]>>> # 記述統計量> (m1 <- mean(data1))[1] 27.03883> (s1 <- sd(data1))[1] 4.315777> (n1 <- length(data1))[1] 103> (m2 <- mean(data2))[1] 25.43617> (s2 <- sd(data2))[1] 6.220947> (n2 <- length(data2))[1] 94> # 確認> library(psych)> describeBy(d1[,c("不安")], d1$説明, mat=TRUE, digits=2)
item group1 vars
n meansd median trimmed mad min max range skew kurtosis
se
X11
1 ビデオ
1 103 27.04 4.32
27
27.12 4.45 17 37
20 -0.10-0.44 0.43
X12
2 看護師
1 94 25.44 6.22
25
25.43 5.93
9 40
31 -0.03-0.15 0.64

> # スクリプトの呼び出し> source("300_自作関数.R")> # 呼び出した関数の実行（効果量の推定）> effectD(n1=n1, n2=n2, m1=m1, m2=m2, s1=s1, s2=s2)
n1
n2
m1
m2
s1
s2
G Lower
103.00 94.00 27.04 25.44
4.32
6.22
0.30
0.02

531

Upper
0.58

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

多変量正規乱数の発生
母集団値を指定した標本の発生
library(MASS)Z <- mvrnorm(n, M, S, tol = 1e-6, empirical = FALSE)
標本値を指定した標本の発生
library(MASS)Z <- mvrnorm(n, M, S, tol = 1e-6, empirical = TRUE)
MASSパッケージは最初からインストールされている．
個体数
平均ベクトル共分散行列を指定する．
標準偏差ベクトル s

n
M
S
と

相関係数行列 Rから

共分散行列 S> setwd("d:\\")>> # 個体数> n <- 245>> # 変数の数> p <- 4>> # 標本平均ベクトル> M <- c(15, 20, 18, 16)>> # 標本標準偏差ベクトル> s <- c(5, 6, 5, 7)>> # 標本相関係数行列> R <- matrix(c(+ 1.0, 0.4, -0.3, -0.6,+ 0.4, 1.0, 0.0, -0.3,+ -0.3, 0.0, 1.0, 0.5,
+ -0.6, -0.3, 0.5, 1.0+ ), p, p)>> # 標本共分散行列の計算> D <- diag(s)> S <- D %*% R %*% D>> # 母集団値を指定した２変量標準正規乱数の発生> library(MASS)> d1 <- mvrnorm(n, M, S, tol = 1e-6, empirical = FALSE)> colnames(d1) <- c("x1","x2","x3","x4")> head(d1)
x1
x2
x3
x4
[1,] 13.600134 19.83877 19.063658 20.2046010[2,] 25.510293 19.20538 9.955946 6.3096060[3,] 12.291883 12.83929 15.114641 27.1414162[4,] 2.399108 10.44224 20.258530 24.6136281[5,] 11.171811 20.51997 18.866531 18.3840800[6,] 20.365074 36.70374 15.259708 0.4885998>
532を作成するのが分かりやすい．

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 記述統計量> dtmp <- d1> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN Mean
1 245 15.37
2 245 20.38
3 245 18.20
4 245 15.59

SD
x1
x2
x3
x4
4.99 1.00 0.40 -0.30 -0.63
6.15 0.40 1.00 0.02 -0.30
4.58 -0.30 0.02 1.00 0.44
6.53 -0.63 -0.30 0.44 1.00>
> # write.table(d1, "Z1.csv", row.names=FALSE, sep=",", fileEncoding="shift-jis")
>
>
>
>
>
>
> # 標本値を指定した２変量標準正規乱数の発生> library(MASS)> d2 <- mvrnorm(n, M, S, tol = 1e-6, empirical = TRUE)> colnames(d2) <- c("x1","x2","x3","x4")> head(d2)
x1
x2
x3
x4
[1,] 28.242407 23.24588 12.789406 6.237946[2,] 18.001552 18.94479 6.832597 14.702094[3,] 2.473954 26.19450 26.504034 25.892094[4,] 20.085287 21.52668 17.093125 6.084849[5,] 22.069442 27.97013 15.041955 7.074444[6,] 10.253586 14.12464 24.115007 24.726687> # 記述統計量> dtmp <- d2> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmp
N
1 245
2 245
3 245
4 245

Mean
15
20
18
16

SD
5
6
5
7

x1
1.0
0.4
-0.3
-0.6

x2
0.4
1.0
0.0
-0.3

x3
-0.3
0.0
1.0
0.5

x4
-0.6
-0.3
0.5
1.0

>
>
> # write.table(d2, "Z2.csv", row.names=FALSE, sep=",", fileEncoding="shift-jis")
>
>

533

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

確率関数# 確率関数dxxxxx : 確率密度関数
pxxxxx : 確率分布関数
qxxxxx : 分位点関数
rxxxxx : 乱数
# ベータ分布
dbeta(x,shape1,shape2),# 二項分布dbinom(x,n0,p0),

pbeta(x,shape1,shape2),

pbinom(x,n0,p0),

qbeta(p,shape1,shape2),

qbinom(p,n0,p0),

rbinom(n,n0,p0)# カイ２乗分布
dchisq(x,df), pchisq(x,df),

qchisq(p,df),

rchisq(n,df)# 指数分布dexp(x,rate),qexp(p,rate),rexp(n,rate)

pexp(x,rate),# ガンマ分布dgamma(x,shape,rate), pgamma(x,shape,rate),# 正規分布dnorm(x,mean,sd),# Ｆ分布df(x,df1,df2),# ｔ分布
dt(x,df),pt(x,df),# 一様分布dunif(x,min,max),

qgamma(p,shape,rate),

pnorm(x,mean,sd), qnorm(p,mean,sd),pf(x,df1,df2),

qt(p,df),

qf(p,df1,df2),

rbeta(n,shape1,shape2)

rgamma(n,shape,rate)rnorm(n,mean,sd)

rf(n,df1,df2)

rt(n,df)

punif(x,min,max),

qunif(p,min,max),

runif(n,min,max)# ワイブル分布
dweibull(x,shape,scale), pweibull(x,shape,scale), qweibull(p,shape,scale), rweibull(n,shape,scale)#

非心分布は，非心パラメタ ncp= を指定すればよい．

> dt(2.7, df=3)[1] 0.03124146> pt(2.7, df=30)[1] 0.9943578> pt(2.7, df=30, ncp=1)[1] 0.9436329> qt(.995, df=30)[1] 2.749996> rt(n=5, df=30)[1] 1.331593 1.638198>

0.912146 -1.974527 -2.168895

534

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

いくつかの図をまとめてPDFファイルに出力
単回帰分析において，説明変数x，基準変数y，誤差e，予測値pとしたときの，次の６個の散布図を３行２列にならべて，PDFファイルに出力する．
x-y, p-y, x-e, p-e, x-p y-e> setwd("d:\\")> d1 <- read.table("回帰分析データ.csv", header=TRUE, sep=",", fileEncoding="shift-jis")> head(d1)
id stress kyoufu support utsu work result
1 1
20
2.2
17
18
0
0
2 2
23
4.8
18
21
1
0
3 3
30
5.8
12
29
1
1
4 4
25
5.2
18
29
0
1
5 5
26
2.0
8
22
1
0
6 6
21
5.0
26
19
1
0
>
>
> # 記述統計量> dtmp <- d1[,c(-1)]> ntmp <- nrow(dtmp)> mtmp <- colMeans(dtmp)> stmp <- apply(dtmp, 2, sd)> ctmp <- cor(dtmp)> ktmp <- round(data.frame(ntmp, mtmp, stmp, ctmp),2)> colnames(ktmp) <- c("N","Mean","SD",colnames(ctmp))> ktmpN MeanSD stress kyoufu support utsu work result
stress 245 22.94 5.25
1.00
0.40
-0.34 0.62 0.03
0.44
kyoufu 245 4.05 1.17
0.40
1.00
-0.03 0.31 0.10
0.20
support 245 18.42 4.96 -0.34 -0.03
1.00 -0.51 -0.03 -0.39
utsu
245 20.29 6.49
0.62
0.31
-0.51 1.00 0.02
0.76
work
245 0.50 0.50
0.03
0.10
-0.03 0.02 1.00 -0.08
result 245 0.26 0.44
0.44
0.20
-0.39 0.76 -0.08
1.00>>> # 単回帰分析> reg.1 <- lm(utsu ~ stress, data=d1)> summary(reg.1)
Call:lm(formula = utsu ~ stress, data = d1)
Residuals:Min
1Q-11.6277 -3.2181

Median-0.0374

3Q
3.0771Max
15.6674

Coefficients:
Estimate Std. Error t value Pr(>|t|)(Intercept) 2.73611
1.46777
1.864
0.0635 .
stress
0.76506
0.06238 12.264<2e-16 ***--Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 5.114 on 243 degrees of freedom
Multiple R-squared: 0.3823,
Adjusted R-squared: 0.3798
F-statistic: 150.4 on 1 and 243 DF, p-value: < 2.2e-16>>> #偏回帰係数の信頼区間> confint(reg.1)
2.5 %
97.5 %(Intercept) -0.1550688 5.6272812
stress
0.6421862 0.8879398>>
535

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> #x,y,e の 散布図をPDFに出力> pdf("残差プロット.pdf", paper="a4", width=7, height=15, family="Japan1")> layout(matrix(c(1,2,3,4,5,6), 3, 2, byrow=T))# ７×15インチの中に６個の図を3行2列に配置>> plot(d1$stress, d1$utsu, xlab="x", ylab="y",ylim=c(0,40),pch=20, las=1, main="x vs. y")>> plot(reg.1$fitted.values, d1$utsu, xlab="predicted y", ylab="y",+ ylim=c(0,40),pch=20, las=1, main="predicted y vs. y")>> plot(d1$stress, reg.1$residuals, xlab="x", ylab="residual", pch=20, las=1,+ main="x vs. e")>> plot( reg.1$fitted.values, reg.1$residuals, xlab="predicted y",+ ylab="residual", pch=20, las=1, main="predicted y vs. e")>> plot(d1$stress, reg.1$fitted.values, xlab="x", ylab="predicted y",+ ylim=c(0,40),pch=20, las=1, main="x vs. predicted y")>> plot(d1$utsu, reg.1$residuals, xlab="y", ylab="residual", pch=20,las=1,+ main="y vs. e")>> layout(1)> dev.off()
null device
1# 出力されたファイル536

名古屋 大学
正規分布と標準得点の対応関係の図を描く# 正規分布と標準得点
setwd("c:\\home\\Rdocuments\\scripts\\")par(mar=c(0,1,0,1))
ycep <- 0.75
dprp <- 0.6
xvals.a <- seq(-3.5,3.5, length=71)
dvals.a <- dnorm(xvals.a)* dprp + ycep
plot(xvals.a, dvals.a, type="l",xlim=c(-4.5,3.5),ylim=c(0,1),
axes=FALSE, ann=FALSE)
segments(-3.5,ycep, 3.5,ycep)
x1 <- c(-3.0, -2.0, -1.0, 0, 1.0, 2.0, 3.0)
for(i in 1:length(x1)){
y1 <- dnorm(x1[i])*dprp+ycep
segments(x1[i],ycep,x1[i], y1)537

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部}
x1 <- c(-2.5, -1.5, -0.5, 0.5, 1.5, 2.5)
for(i in 1:length(x1)){
y1 <- dnorm(x1[i])*dprp+ycep
segments(x1[i],ycep,x1[i], y1, lty="dashed")}
ycep1 <- ycep-0.02
text(-3, ycep1, "μ-3σ", cex=0.75)
text(-2, ycep1, "μ-2σ", cex=0.75)
text(-1, ycep1, "μ-1σ", cex=0.75)
text(0, ycep1, "μ", cex=0.75)
text(1, ycep1, "μ+1σ", cex=0.75)
text(2, ycep1, "μ+2σ", cex=0.75)
text(3, ycep1, "μ+3σ", cex=0.75)# percentycep1 <- ycep1-0.06
x1 <- c(-3.3,-2.75,-2.25,-1.75,-1.25,-.75,-.25,.25,.75,1.25,1.75,2.25,2.75,3.3)
y1 <- c(0.13,0.49,1.66,4.40,9.19,14.98,19.15,19.15,14.98,9.19,4.40,1.66,0.49,0.13)
for(i in 1:length(x1)){
text(x1[i], ycep1, y1[i], cex=0.75)}
ycep1 <- ycep1-0.02
ycep1u <- ycep1 + 0.01
segments(-3.2,ycep1, 3.2,ycep1)
x1 <- c(-3.0,-2.5,-2.0,-1.5,-1.0,-0.5,0,0.5,1.0,1.5,2.0,2.5,3.0)
for(i in 1:length(x1)){
segments(x1[i],ycep1,x1[i], ycep1u)}
ycep1 <- ycep1-0.02
x1 <- c(-3.3, -2.5,-1.5,-.5,.5,1.5,2.5,3.3)
y1 <- c(0.13,2.14,13.59,34.13,34.13,13.59,2.14,0.13)
for(i in 1:length(x1)){
text(x1[i], ycep1, y1[i], cex=0.75)}
text(-4, ycep1, "パーセント", cex=0.75)
ycep1 <- ycep1-0.02
ycep1u <- ycep1 + 0.01
ycep1s <- ycep1 - 0.01
segments(-3.2,ycep1, 3.2,ycep1)
x1 <- c(-3.0, -2.0, -1.0, 0, 1.0, 2.0, 3.0)
y1 <- c(-2.5, -1.5, -0.5, 0.5, 1.5, 2.5)
for(i in 1:length(x1)){
segments(x1[i],ycep1,x1[i], ycep1u)
segments(y1[i],ycep1,y1[i], ycep1s)}
ycep1 <- ycep1-0.02
x1 <- c(-3,-2,-1,0,1,2,3)
y1 <- c(0.62,6.06,24.17,38.30,24.17,6.06,0.62)
for(i in 1:length(x1)){
text(x1[i], ycep1, y1[i], cex=0.75)}# Q1-Q3
ycep1 <- ycep1-0.06
ycep1m <- ycep1 + 0.01
ycep1u <- ycep1 + 0.02
ycep1s <- ycep1 - 0.02
text(-4, ycep1, "四分位範囲", cex=0.75)
segments(-3.2,ycep1, 3.5,ycep1)
x1 <- c(0.25, 0.50, 0.75)
y1 <- c("Q1", "Q2", "Q3")
for(i in 1:length(x1)){
xq <- qnorm(x1[i])segments(xq,ycep1, xq, ycep1m)text(xq, ycep1s, y1[i], cex=0.75)
538

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部}
z1 <- c(25, 25, 25, 25)
w1 <- c(-1, -0.25, 0.25, 1)for(i in 1:length(z1)){
text(w1[i], ycep1u, z1[i], cex=0.75)}# percintile orderycep1 <- ycep1-0.06
ycep1m <- ycep1 + 0.01
ycep1u <- ycep1 + 0.02
ycep1s <- ycep1 - 0.02
text(-4, ycep1, "パーセンタイル順位", cex=0.75)
segments(-3.2,ycep1, 3.5,ycep1)
x1 <- c(0.01, 0.025, 0.05, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 0.95, 0.975, 0.99)
y1 <- c(1, 2.5, 5, 10, 20, 30, 40, 50, 60, 70, 80, 90, 95, 97.5, 99)for(i in 1:length(x1)){
xq <- qnorm(x1[i])segments(xq,ycep1, xq, ycep1m)text(xq, ycep1s, y1[i], cex=0.75)}# z scoreycep1 <- ycep1-0.09
ycep1m <- ycep1 + 0.01
ycep1u <- ycep1 + 0.02
ycep1s <- ycep1 - 0.02
text(-4, ycep1, "z得点", cex=0.75)
segments(-3.5,ycep1, 3.5,ycep1)
x1 <- c(-3.0, -2.0, -1.0, 0, 1.0, 2.0, 3.0)
y1 <- c(-3.0, -2.0, -1.0, 0, 1.0, 2.0, 3.0)
for(i in 1:length(x1)){
segments(x1[i],ycep1,x1[i], ycep1m)text(x1[i], ycep1s, y1[i], cex=0.75)}
x1 <- c(-2.5, -1.5, -0.5, 0.5, 1.5, 2.5)
y1 <- c(2.15, 13.59, 34.13, 34.13, 13.59, 2.15)
for(i in 1:length(x1)){#text(x1[i], ycep1u, y1[i], cex=0.75)}# T scoreycep1 <- ycep1-0.06
ycep1m <- ycep1 + 0.01
ycep1u <- ycep1 + 0.02
ycep1s <- ycep1 - 0.02
text(-4, ycep1, "偏差値(T得点)", cex=0.75)
segments(-3.5,ycep1, 3.5,ycep1)
x1 <- c(-3.0, -2.0, -1.0, 0, 1.0, 2.0, 3.0)
y1 <- c(20, 30, 40, 50, 60, 70, 80)
for(i in 1:length(x1)){
segments(x1[i],ycep1,x1[i], ycep1m)text(x1[i], ycep1s, y1[i], cex=0.75)}# IQ
ycep1 <- ycep1-0.06
ycep1m <- ycep1 + 0.01
ycep1u <- ycep1 + 0.02
ycep1s <- ycep1 - 0.02
text(-4, ycep1, "偏差IQ", cex=0.75)
segments(-3.5,ycep1, 3.5,ycep1)
x1 <- c(-3.0, -2.0, -1.0, 0, 1.0, 2.0, 3.0)
y1 <- c(55, 70, 85, 100, 115, 130, 145)
for(i in 1:length(x1)){
segments(x1[i],ycep1,x1[i], ycep1m)text(x1[i], ycep1s, y1[i], cex=0.75)}
539

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部# 5 rank
ycep1 <- ycep1-0.09
ycep1m <- ycep1 + 0.01
ycep1u <- ycep1 + 0.02
ycep1s <- ycep1 - 0.02
text(-4, ycep1, "5段階評価", cex=0.75)
segments(-3.5,ycep1, 3.5,ycep1)
x1 <- c(0.07, 0.24, 0.38, 0.24)
x2 <- 0for(i in 1:length(x1)){
x2 <- x2+x1[i]xq <- qnorm(x2)segments(xq,ycep1, xq, ycep1m)}
x1 <- c(-2, -1, 0, 1, 2)
y1 <- c(1, 2, 3, 4, 5)
z1 <- c(7, 24, 38, 24, 7)
for(i in 1:length(x1)){
text(x1[i], ycep1u, z1[i], cex=0.75)
text(x1[i], ycep1s, y1[i], cex=0.75)}# C scoreycep1 <- ycep1-0.09
ycep1m <- ycep1 + 0.01
ycep1u <- ycep1 + 0.02
ycep1s <- ycep1 - 0.02
text(-4, ycep1, "C得点", cex=0.75)
segments(-3.5,ycep1, 3.5,ycep1)
x1 <- c(0.01, 0.03, 0.07, 0.12, 0.17, 0.20, 0.17, 0.12, 0.07, 0.03)
x2 <- 0for(i in 1:length(x1)){
x2 <- x2+x1[i]xq <- qnorm(x2)segments(xq,ycep1, xq, ycep1m)}
x1 <- c(-2.5,-2.0,-1.5,-1.0,-0.5,0,0.5,1.0,1.5,2.0,2.5)
y1 <- c(0,1, 2, 3, 4, 5,6,7,8,9,10)
z1 <- c(1,3,7,12,17,20,17,12,7,3,1)
for(i in 1:length(x1)){
text(x1[i], ycep1u, z1[i], cex=0.75)
text(x1[i], ycep1s, y1[i], cex=0.75)}# stanine
ycep1 <- ycep1-0.06
ycep1m <- ycep1 + 0.01
ycep1u <- ycep1 + 0.02
ycep1s <- ycep1 - 0.02
text(-4, ycep1, "スタナイン", cex=0.75)
segments(-3.5,ycep1, 3.5,ycep1)
x1 <- c(0.04, 0.07, 0.12, 0.17, 0.20, 0.17, 0.12, 0.07)
x2 <- 0for(i in 1:length(x1)){
x2 <- x2+x1[i]xq <- qnorm(x2)segments(xq,ycep1, xq, ycep1m)}
x1 <- c(-2.25,-1.5,-1.0,-0.5,0,0.5,1.0,1.5,2.25)
y1 <- c(1, 2, 3, 4, 5,6,7,8,9)
for(i in 1:length(x1)){
text(x1[i], ycep1s, y1[i], cex=0.75)}
text(-3.5, 0.95, "正規分布")540

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

統計的有意性検定の概念図を描く

par(mar=c(0,1,0,1))
ycep <- 0.2
xvals.a <- seq(-3,3, length=61)
dvals.a <- dnorm(xvals.a)+ycep
plot(xvals.a, dvals.a, type="l", ylim=c(0,0.65), axes=FALSE, ann=FALSE)
segments(-3,ycep, 3,ycep)
xvals.l <- seq(-3,-2, length=21)
dvals.l <- dnorm(xvals.l)+ycep
xvals.u <- seq(2,3, length=21)
dvals.u <- dnorm(xvals.u)+ycep
polygon(c(xvals.l, rev(xvals.l)), c(rep(ycep,21), rev(dvals.l)), col="gray")polygon(c(xvals.u, rev(xvals.u)), c(rep(ycep,21), rev(dvals.u)), col="gray")xvals.pl <- seq(-3,-2.3, length=8)
dvals.pl <- dnorm(xvals.pl)+ycep
xvals.pu <- seq(2.3,3, length=8)
dvals.pu <- dnorm(xvals.pu)+ycep
polygon(c(xvals.pl, rev(xvals.pl)), c(rep(ycep,8), rev(dvals.pl)), col="black")
polygon(c(xvals.pu, rev(xvals.pu)), c(rep(ycep,8), rev(dvals.pu)), col="black")
segments(-2,ycep, -2,0)
segments(2,ycep, 2,0)
arrows(-2,ycep, -0.5, ycep-0.05, code=1, length=0.1)
arrows( 2,ycep, 0.5, ycep-0.05, code=1, length=0.1)
text(0, ycep-0.05, "限界値")
arrows( 2.3,ycep, 2.3, ycep-0.05, code=1, length=0.1)
text(2.3, ycep-0.05, "検定統計量の値")
arrows(-2.2, ycep+0.025, -2.2, ycep+0.15, code=1, length=0.1)
arrows( 2.2, ycep+0.025, -2.2, ycep+0.15, code=1, length=0.1)
text(-2.2, ycep+0.17, "有意水準")
arrows(-2.5, ycep+0.01, 2.5, ycep+0.19, code=1, length=0.1)
arrows( 2.5, ycep+0.01, 2.5, ycep+0.19, code=1, length=0.1)
541

名古屋 大学
text(2.5, ycep+0.21, "有意確率")
arrows( -1, ycep+0.25, -1.7, ycep+0.3, code=1, length=0.1)
text(-2, ycep+0.34, "帰無仮説が正しいときの")text(-2, ycep+0.32, "検定統計量の分布")
arrows(-2, ycep-0.1, 2, ycep-0.1, code=3, length=0.1)
arrows(-2, ycep-0.1, -3, ycep-0.1, code=1, length=0.1)
arrows( 2, ycep-0.1, 3, ycep-0.1, code=1, length=0.1)
text(0, ycep-0.12, "採択域（保持域）")
text(-2.5, ycep-0.12, "棄却域")
text(2.5, ycep-0.12, "棄却域")

542

大 学院 教育発 達科 学研 究科・ 教育 学部

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

なるべくグループメンバーが重ならないグループ分けを複数回行う授業に参加する学生を，毎回の授業でグループ分けするにあたって，なるべくグループメンバーが同じにならないようにグループ分けするプログラム。
ひととおりグループ分けはできるが，ある程度の偏りは残るので，結果をみて，最後は手動で調整すると良い。

必須入力項目
必須入力項目は以下の３つ。
受講者名
names <- c("あ","い","う","え","お","か","き","く","け","こ","さ","し","す","せ")各受講者を特定できるものであれば良い。
グループ数gph <- 4b人のグループ数を最大にして，b人のグループとb-1人のグループを作る。
授業回数nclass0 <- 12

指定可能な項目
以下の各値を指定することもできる。
グループ人数偏り回数（期待回数より何回多くてよいか。2回くらいが適当）
nga <- 2
各受講者が，b人グループおよびb-1人グループに所属する回数が期待値よりも多くなる許容範囲。
同一ペア偏り回数（期待回数より何回多くて良いか。2回くらいが適当）
npa <- 2
同一の受講者ペアが同じグループに所属する回数が期待値よりも多くなる許容範囲。
各受講者において，出現回数がMAXとなるペアの上限数
samepairs <- 3
繰り返し数上限
iterr <- 5000
グループ分けがうまく行かなかったとき，何回まで試行を繰り返すかの上限数。

出力結果> # 少ない方のグループ人数と１回あたりのグループ数> c(a,g)[1] 3 2# 3人グループが2つ> # 多い方のグループ人数と1回あたりのグループ数> c(b,h)[1] 4 2
# 4人グループが2つ>> # 各受講者がb-1人グループになる回数> n3
あ い う え お か き く け こ さ し す せ
6 7 3 6 4 3 5 3 5 5 7 5 7 6> # 各受講者がb人グループになる回数> n4
あ い う え お か き く け こ さ し す せ
6 5 9 6 8 9 7 9 7 7 5 7 5 6>543

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部> # 各受講者ペアが同じグループになる回数（出現数がMAXとなる回数が多い順）> mpair2
mpairorder う せ か く け え い さ す き こ し あ お
う 0 1 4 4 3 2 0 2 3 2 2 3 4 3
せ 1 0 1 3 4 4 4 1 2 0 3 2 3 2
か 4 1 0 3 3 3 2 2 4 2 1 3 3 2
く 4 3 3 0 3 0 2 4 1 3 1 3 3 3
け 3 4 3 3 0 1 2 1 4 3 2 3 1 1
え 2 4 3 0 1 0 2 0 2 3 4 3 3 3
い 0 4 2 2 2 2 0 4 3 2 3 1 3 1
さ 2 1 2 4 1 0 4 0 1 3 2 3 3 3
す 3 2 4 1 4 2 3 1 0 2 2 0 2 3
き 2 0 2 3 3 3 2 3 2 0 3 4 1 3
こ 2 3 1 1 2 4 3 2 2 3 0 3 2 3
し 3 2 3 3 3 3 1 3 0 4 3 0 0 3
あ 4 3 3 3 1 3 3 3 2 1 2 0 0 2
お 3 2 2 3 1 3 1 3 3 3 3 3 2 0>

> # 各回に各受講者が所属するグループ> mstudents2
Class う せ か く け え い さ す き こ し あ お
1
1 2 3 4 3 3 1 4 4 2 4 1 1 2 32
2 3 2 4 3 3 4 1 1 4 3 2 2 4 1
3
3 4 1 2 3 2 4 1 3 1 4 2 4 3 3
4
4 3 3 4 3 1 4 2 3 1 1 2 4 2 45
5 4 1 4 4 1 1 2 2 3 3 3 2 4 36
6 3 2 3 4 3 1 4 4 2 1 4 3 1 27
7 3 4 4 1 3 4 1 2 3 1 3 2 4 28
8 1 3 2 2 3 1 3 4 2 4 4 4 3 1
9
9 1 2 4 3 4 2 4 1 4 3 2 3 1 3
10
10 4 3 2 3 3 1 1 2 1 2 4 3 4 4
1111 4 3 4 1 2 3 3 1 4 2 3 2 1 4
1212 3 1 3 3 2 4 1 2 2 4 4 3 1 4> # 各回のグループ> mgn
回グループ 12
34[1,] "1" "1""え" "こ" "し" ""[2,] "1" "2""あ" "う" "す" ""[3,] "1" "3""お" "く" "け" "せ"[4,] "1" "4""い" "か" "き" "さ"[5,] "2" "1""い" "お" "さ" ""[6,] "2" "2""こ" "し" "せ" ""[7,] "2" "3""う" "き" "く" "け"[8,] "2" "4""あ" "え" "か" "す"[9,] "3" "1""い" "す" "せ" ""[10,] "3" "2""か" "け" "こ" ""[11,] "3" "3""あ" "お" "く" "さ"[12,] "3" "4""う" "え" "き" "し"[13,] "4" "1""き" "け" "す" ""[14,] "4" "2""あ" "い" "こ" ""[15,] "4" "3""う" "く" "さ" "せ"[16,] "4" "4""え" "お" "か" "し"[17,] "5" "1""え" "け" "せ" ""[18,] "5" "2""い" "さ" "し" ""[19,] "5" "3""お" "き" "こ" "す"[20,] "5" "4""あ" "う" "か" "く"[21,] "6" "1""あ" "え" "き" ""[22,] "6" "2""お" "す" "せ" ""[23,] "6" "3""う" "か" "け" "し"[24,] "6" "4""い" "く" "こ" "さ"[25,] "7" "1""い" "き" "く" ""[26,] "7" "2""お" "さ" "し" ""[27,] "7" "3""う" "け" "こ" "す"[28,] "7" "4""あ" "え" "か" "せ"[29,] "8" "1""う" "え" "お" ""[30,] "8" "2""か" "く" "す" ""544

名古屋 大学[31,] "8" "3"[32,] "8" "4"[33,] "9" "1"[34,] "9" "2"[35,] "9" "3"[36,] "9" "4"[37,] "10" "1"[38,] "10" "2"[39,] "10" "3"[40,] "10" "4"[41,] "11" "1"[42,] "11" "2"[43,] "11" "3"[44,] "11" "4"[45,] "12" "1"[46,] "12" "2"[47,] "12" "3"[48,] "12" "4">

大 学院 教育発 達科 学研 究科・ 教育 学部"あ" "い" "け" "せ""き" "こ" "さ" "し""あ" "う" "さ" """え" "こ" "せ" """お" "き" "く" "し""い" "か" "け" "す""い" "え" "す" """か" "き" "さ" """く" "け" "し" "せ""あ" "う" "お" "こ""あ" "く" "さ" """き" "け" "し" """い" "え" "こ" "せ""う" "お" "か" "す""あ" "い" "せ" """け" "さ" "す" """う" "か" "く" "し""え" "お" "き" "こ"> # 全授業回数，グループ分けできた授業回数，繰り返し数> print(c(nclass0, p,r))[1] 12 12 548># 全授業回数とグループ分けできた授業回数が一致していれば，グループ分けが完成したことになる。
# 繰り返し数が指定値+1になっている場合は，グループ分けが完成してしていないので，# プログラムを再実行する。
# 各受講者ペアが同じグループになる回数，各回に各受講者が所属するグループ，各回のグループ# の３つの結果は，CSVファイルに結果を保存するスクリプトもついている。

545

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部# グループ分けプログラム# 自動でできるのはある程度まで。 結果をみて手動で調整すると，さらに良くなります。
# 繰り返し数が上限+1 になった場合は，グループ分けが完成していないので，再実行する。
rm(list=ls())
setwd("c:\\home\\Rdocuments\\scripts\\")# 受講者名
names <- c("あ","い","う","え","お","か","き","く","け","こ","さ","し","す","せ")# グループ数
gph <- 4# 授業回数nclass0 <- 12# グループ人数偏り回数（期待回数より何回多くてよいか。2回くらいが適当）
nga <- 2# 同一ペア偏り回数（期待回数より何回多くて良いか。2回くらいが適当）
npa <- 2# 各受講者において，出現回数がMAXとなるペアの上限数
samepairs <- 3
# 繰り返し数上限
iterr <- 10000#-------------------------------------------------------------------------# 追加授業回数（2回くらいが適当）
nclassadd <- 2
# 合計授業回数
nclass <- nclass0 + nclassadd# １試行における乱数発生回数上限
iter <- nclass0# 受講者数(n <- length(names))# 多い方のグループの人数(b <- n %/% gph +1)# 少ない方のグループの人数=多い方の人数-1(a <- b-1)
# 人数が多い方のグループの数(h <- n %% gph)
# 人数が少ない方のグループの数(g <- gph - h)
# 1回のグループ分けでできるペア数(npi <- a*(a-1)/2*g + b*(b-1)/2*h)# すべての回のグループ分けでできるペアの総数(npall <- npi * nclass)# 受講者の総当たりペア数(npt <- n*(n-1)/2)# ペアの期待出現回数(enp <- npall/npt)# 出現回数上限(uenp <- enp+npa)
546

名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部# 人数が少ない方のグループになる期待回数(en3 <- g/gph * nclass)# 人数が多い方のグループになる期待回数(en4 <- h/gph * nclass)#-------------------------------------------------------------------------r <- 0
repeat{r <- r+1#-------------------------------------------------------------------------# 各受講者がb-1人グループに入った回数(n3 <- rep(0,n))# 各受講者がb人グループに入った回数(n4 <- rep(0,n))# 仮の各受講者がb-1人グループに入った回数
n3temp <- rep(0, n)# 仮の各受講者がb人グループに入った回数
n4temp <- rep(0, n)# 各ペアの出現回数を保存する行列
mpair <- matrix(c(0), nrow = n, ncol = n, byrow = TRUE)
colnames(mpair) <- names
rownames(mpair) <- names
mpair1<- mpair# 仮の各ペアの出現回数を保存する行列
mpairtemp <- matrix(c(0), nrow = n, ncol = n, byrow = TRUE)
colnames(mpairtemp) <- names
rownames(mpairtemp) <- names# 各受講者の各回のグループ番号を保存する行列
mstudents <- matrix(c(0), nrow = nclass0, ncol = n, byrow = TRUE)
colnames(mstudents) <- names
rownames(mstudents) <- c(1:nclass0)# 各回のグループ分けを保存する行列
mgn <- matrix("", nrow = (nclass0*gph), ncol = (b+2), byrow=TRUE)
colnames(mgn) <- c("回","グループ", c(1:b))#--------------------------------------------------------------------------# 繰り返し処理の初期値
p <- 0q <- 0repeat{# 乱数発生繰り返し数
q <- q+1# 乱数発生(rv <- rnorm(n))# オーダー(orv <- order(rv))
547名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部# 仮グループ番号
gtemp <- rep(0, n)# カウンターk <- 1# グループ分け
for(i in 1:g){for(j in 1:a){
gtemp[orv[k]] <- in3temp[orv[k]] <- n3[orv[k]]+1
k <- k+1}}
for(i in 1:h){for(j in 1:b){
gtemp[orv[k]] <- g+i
n4temp[orv[k]] <- n4[orv[k]]+1
k <- k+1}}# 各受検者が，多い方のグループ，少ない方のグループに，なるべく偏りなく入るようにする
if ((max(n3temp) <= (en3+nga)) & (max(n4temp) <= (en4+nga))){n3 <- n3temp
n4 <- n4temp
if (g >=1){
for(i in 1:g){for(j1 in 1:(a-1)){
for(j2 in (j1+1):a){ki <- a*(i-1)+j1
kj <- a*(i-1)+j2
mpairtemp[orv[ki],orv[kj]] <- mpair[orv[ki],orv[kj]]+1
mpairtemp[orv[kj],orv[ki]] <- mpairtemp[orv[ki],orv[kj]]}}}}if (h>=1){
for(i in 1:h){for(j1 in 1:(b-1)){
for(j2 in (j1+1):b){ki <- a*g + b*(i-1)+j1
kj <- a*g + b*(i-1)+j2
mpairtemp[orv[ki],orv[kj]] <- mpair[orv[ki],orv[kj]]+1
mpairtemp[orv[kj],orv[ki]] <- mpairtemp[orv[ki],orv[kj]]}}}}# なるべく異なる受講者とグループになるようにする
if (max(mpairtemp)<= uenp){
mpair <- mpairtempp <- p+1
mstudents[p,] <- gtemp}}
if ((p == (nclass0)) | (q > iter)) break}# ペアになることが多い受講者
maxmpair <- max(mpair)
mpair4s <- mpairsum <- rep(0,n)
names(mpair4s) <- names(mpairsum) <- names
for(i in names){
mpair4s[i] <- sum(mpair[i,]==maxmpair)
mpairsum[i] <- sum(mpair[i,])}548名古屋 大学

大 学院 教育発 達科 学研 究科・ 教育 学部

if (max(mpair4s)>samepairs) p <- 0
if ((p == (nclass0)) | (r > iterr)) break}names(n3) <- names
names(n4) <- names
mpairorder <- names[order(-mpair4s, -mpairsum)]mpair1 <- mpair[mpairorder, mpairorder]
mpair1 <- data.frame(mpairorder,mpair1)
mpair2 <- mpair1for(i in 1:n){for(j in 2:(i+1)){
mpair2[i,j] <- ""}}mstudents1 <- mstudents[,mpairorder]names1 <- colnames(mstudents1)
mstudents2 <- data.frame(c(1:nclass0),mstudents1)
colnames(mstudents2) <- c("Class",names1)
rc <- 0for(i in 1:nclass0){
for(j in 1:gph){rc <- rc+1
mgn[rc,1] <- i
mgn[rc,2] <- jstudents <- names(mstudents[i,(mstudents[i,] %in% j)])mgn[rc,3:(2+length(students))] <- students
}
}

# 結果
# 少ない方のグループ人数と１回あたりのグループ数
c(a,g)# 多い方のグループ人数と1回あたりのグループ数
c(b,h)# 各受講者がb-1人グループになる回数
n3# 各受講者がb人グループになる回数
n4# 各受講者ペアが同じグループになる回数（出現数がMAXとなる回数が多い順）
mpair1# 各回に各受講者が所属するグループ
mstudents2# 各回のグループmgn# 全授業回数，グループ分けできた授業回数，繰り返し計算数
print(c(nclass0, p,r))# ファイル出力
write.table(mpair1, "mpair1.csv", row.names=FALSE, sep=",")
write.table(mstudents2, "mstudents2.csv", row.names=FALSE, sep=",")
write.table(mgn, "mgn.csv", row.names=FALSE, sep=",")
549