##################################################################### ##################################################################### #南風原朝和（2002）心理統計学の基礎 有斐閣 #第2章 分布の記述的指標とその性質 ##################################################################### ##################################################################### #-------------------------------------------------------------------# #Step1: データハンドリング #-------------------------------------------------------------------# ##(a) データと変数名リストの読み込み setwd("Z:/workshop2006/haebara") dat <- read.table("tab1_1.csv", header=T, sep=",") labeldat <- read.table("tab1_1label.csv", header=T, sep=",", na="") ##(b) 質的変数の代入 attach(labeldat) y <- as.character(label[!is.na(code1)]) #選択肢がある変数名をyとおく nalt <- paste("code", 1:2, sep="") #選択肢の変数名をnaltとおく for(i in 1:length(y)){ alternative <- labeldat[label == y[i], nalt] #選択肢がある変数名の選択肢をalternativeとおく alternative <- as.character(t(alternative)) dat[, y[i]] <- factor(dat[, y[i]], labels=alternative) #質的変数を代入する } detach(labeldat) ##(c) idが一致するものを展開する datwide <- reshape(dat, idvar="id", timevar="time", direction="wide", v.names="point") ##(d) 変化量の得点を算出する datwide$diff <- datwide$point.中2 - datwide$point.小6 datwide #表1.1 #-------------------------------------------------------------------# #Step2：代表値 中央値(pp.17-20) #-------------------------------------------------------------------# #【宿題 1】_____________________________________________ #・表1-1の最初の5人の被験者の小6のときの逸脱行動得点をxとおき # 代表値の候補tを10とした場合のT1の値 (2.1 式)を求めること ##関数は，sum(), abs()を使用すること #_______________________________________________________ x <- datwide[1:5, 3] #【宿題 2】_____________________________________________ #・表1-1の最初の5人の被験者の小6のときの逸脱行動得点をxとおき # 代表値の候補tを14とした場合のT1の値 (2.1 式)を求めること ##関数は，sum(), abs()を使用すること #_______________________________________________________ #【宿題 3】_____________________________________________ #・以下のプログラム(a), (b) は， # T1の値が，中央値 (14) の時に最小の値になるかを確認するためのものである。 #・何をしているのか，プログラムを読み解くこと #・プログラム(a)，(b) は優劣のあるものではなく， # どちらも，使用できるようになることが望ましい #_______________________________________________________ ##(a) for を使って求める #代表値の候補tを「xの最小値から，最大値まで.01ずつ増加するベクトル」とする t <- seq(min(x), max(x), by=.01) #T1の値をとりあえず，tと同じサイズの0ベクトルとする T1 <- numeric(length(t)) #2.1式を求める関数を，tのサイズ回，繰り返して，T1に代入する for(i in 1:length(t)){ T1[i] <- sum(abs(x - t[i])) } #T1とtの値の対応関係を見る par(mfrow=c(2, 1)) plot(T1~t) ##(b) 行列を使って求める T1 <- apply( #行の和を求める abs( #絶対値を取る matrix(x, nrow=length(t), ncol=length(x), byrow=T) #xを行列に変換する - #行列からベクトルを引く t ), 1, sum) plot(T1~t) graphics.off() #-------------------------------------------------------------------# #Step3：代表値 平均値(pp.20-22) #-------------------------------------------------------------------# #【宿題 4】_____________________________________________ #・表1-1の最初の5人の被験者の小6のときの逸脱行動得点をxとおき # 2.2式を参照して平均値を計算するプログラムを書くこと ##関数は，sum(), length() を使用すること #_______________________________________________________ #【宿題 5】_____________________________________________ #・表1-1の最初の5人の被験者の小6のときの逸脱行動得点をxとおき # 代表値の候補tを平均値(11.6)とした場合のT2の値 (2.3 式)を求めること ##関数は，sum(), length()を使用すること #_______________________________________________________ #【宿題 6】_____________________________________________ #・宿題3を参考して，T2の値が， # 平均値の時に最小の値になるかを確認するプログラムを2種類書くこと #_______________________________________________________ #-------------------------------------------------------------------# #Step4：逸脱行動データの代表値 (表2.1) #-------------------------------------------------------------------# #【宿題 7】_____________________________________________ #・以下のプログラム(a), (b), (c) は， # 表2.1を再現するためのものである。 #・何をしているのか，プログラムを読み解くこと #_______________________________________________________ ##(a) tapply(ベクトル，質的変数, 関数) で，質的変数ごとの平均値などを求める ## 質的変数が複数の場合はlist(質的変数1, 質的変数2) と指定する attach(datwide) tapply(X=point.小6, INDEX=sex, FUN=median) #男女別，小6の逸脱行動得点の中央値 tapply(point.小6, sex, mean) #男女別，小6の逸脱行動得点の平均値 tapply(point.中2, sex, median) #男女別，中2の逸脱行動得点の中央値 tapply(point.中2, sex, mean) #男女別，中2の逸脱行動得点の平均値 tapply(diff, sex, median) #男女別，変化量の中央値 tapply(diff, sex, mean) #男女別，変化量の平均値 median(point.小6) #全体の小6の逸脱行動得点の中央値 mean(point.小6) #全体の小6の逸脱行動得点の平均値 median(point.中2) #全体の中2の逸脱行動得点の中央値 mean(point.中2) #全体の中2の逸脱行動得点の平均値 median(diff) #全体の変化量の中央値 mean(diff) #全体の変化量の平均値 detach(datwide) ##(b) aggregate(データフレームや行列，list(質的変数), 関数) で， ## 質的変数ごとの平均値などを求める。 ## 質的変数が複数の場合はlist(質的変数1, 質的変数2) と指定する aggregate(datwide[,3:5], list(datwide[,2]), median) #1列目はGroup.1と表示される aggregate(datwide[,3:5], list(性別=datwide[,2]), median) #1列目は性別と表示される aggregate(datwide[,3:5], list(datwide[,2]), mean) apply(datwide[,3:5], 2, median) #全体の中央値 apply(datwide[,3:5], 2, mean) #全体の平均値 ##(c) 質的変数がある場合の平均値と中央値を求める関数を定義する data <- datwide[,3:5] INDEX <- list(性別=datwide[,2]) summary.tendency <- function(data, INDEX){ out1 <- aggregate(data, INDEX, median) #質的変数別中央値 out2 <- aggregate(data, INDEX, mean) #質的変数別平均値 out3 <- apply(data, 2, median) #全体の中央値 out4 <- apply(data, 2, mean) #全体の平均値 #list()で結果を統合する output <- list(中央値=out1, 平均値=out2, 中央値=out3, 平均値=out4) return(output) } summary.tendency(data=datwide[,3:5], INDEX=list(性別=datwide[,2])) #-------------------------------------------------------------------# #Step5：合成変数の平均と合併した集団における平均 (pp.26-27) #-------------------------------------------------------------------# #【宿題 8】_____________________________________________ #・合成変数の平均を求める関数composite.mean (2.6式)を作成すること # 引数は，x, y, c, dとすること #_______________________________________________________ attach(datwide) x <- point.小6 y <- point.中2 c <- -1 d <- 1 detach(datwide) composite.mean <- function(x, y, c, d){ return() } composite.mean(x, y, c, d) #【宿題 9】_____________________________________________ #・合併した集団における平均を求める関数merged.mean (2.7式)を作成すること # 引数は，m1, m2, n1, n2とすること #_______________________________________________________ attach(datwide) n1 <- sum(sex=="男") n2 <- sum(sex=="女") N <- length(sex) m1 <- mean(diff[sex=="男"]) m2 <- mean(diff[sex=="女"]) detach(datwide) merged.mean <- function(m1, m2, n1, n2){ return() } merged.mean(m1, m2, n1, n2) #-------------------------------------------------------------------# #Step6：平均偏差 (pp.28-29) #-------------------------------------------------------------------# #【宿題 10】_____________________________________________ #・中央値からの平均偏差を求める関数md.median(2.9式)を作成すること # 引数は，xとすること #_______________________________________________________ x <- datwide[1:5, 3] md.median <- function(x){ return() } md.median(x) #【宿題 11】_____________________________________________ #・平均値からの平均偏差を求める関数md.mean(2.10式)を作成すること # 引数は，xとすること #_______________________________________________________ md.mean <- function(x){ return() } md.mean(x) #-------------------------------------------------------------------# #Step7：分散と標準偏差 (pp.30-32) #-------------------------------------------------------------------# #【宿題 12】_____________________________________________ #・分散を求める関数svar(2.12式)を作成すること # 引数は，xとすること #_______________________________________________________ svar <- function(x){ return() } svar(x) #【宿題 13】_____________________________________________ #・標準偏差を求める関数ssd(2.13式)を作成すること # 引数は，xとすること #_______________________________________________________ ssd <- function(x){ return() } ssd(x) #【宿題 14】_____________________________________________ #・不偏分散を求める2.14式を書き， # 関数var()と同一の解が得られることを確認すること #_______________________________________________________ #2.14式 var(x) #【宿題 15】_____________________________________________ #・不偏標準偏差を求める2.15式を書き， # 関数sd()と同一の解が得られることを確認すること #_______________________________________________________ #2.15式 sd(x) #-------------------------------------------------------------------# #Step7：逸脱行動データの散布度 (pp.33-34) #-------------------------------------------------------------------# #【宿題 16】_____________________________________________ #・宿題7を参考にして，表2.2を再現すること #_______________________________________________________ #-------------------------------------------------------------------# #Step8：合成変数の分散と合併した集団における分散 (pp.34-37) #-------------------------------------------------------------------# #【宿題 17】_____________________________________________ #・合成変数の分散を求める関数composite.var (2.18式)を作成すること # 引数は，x, yとすること #_______________________________________________________ attach(datwide) xy <- diff x <- point.小6 y <- point.中2 detach(datwide) svar(xy) svar(x) + svar(y) composite.var <- function(x, y){ return() } composite.var(x, y) svar(xy) #【宿題 18】_____________________________________________ #・合併した集団における分散を求める関数merged.var (2.19式)を作成すること # 引数は，x, yとすること #_______________________________________________________ attach(datwide) m1 <- mean(point.小6[sex=="男"]) m2 <- mean(point.小6[sex=="女"]) var1 <- svar(point.小6[sex=="男"]) var2 <- svar(point.小6[sex=="女"]) n1 <- sum(sex=="男") n2 <- sum(sex=="女") detach(datwide) merged.var <- function(m1, m2, var1, var2, n1,n2){ return() } merged.var(m1, m2, var1, var2, n1, n2) svar(datwide$point.小6) #-------------------------------------------------------------------# #Step10：変数の線形変換と標準化 (pp.37-41) #-------------------------------------------------------------------# #【宿題 19】_____________________________________________ #・線形変換をする関数linear.trans (2.20式)を作成すること # 引数は，x, c, dとすること #_______________________________________________________ x1 <- datwide$diff c <- 5 d <- 0 linear.trans <- function(x, c, d){ return() } #【宿題 20】_____________________________________________ #・2.22-2.24式が成立することを確認すること #_______________________________________________________ x2 <- linear.trans(x1, c, d) #2.21式 mean(x1) * c + d #右辺 mean(x2) #左辺 #2.22式 #右辺 #右辺 md.median(x2) #左辺 md.mean(x2) #左辺 #2.23式 #右辺 ssd(x2) #左辺 #2.24式 #右辺 svar(x2) #左辺 #【宿題 21】_____________________________________________ #・以下のプログラムは， # 平均0，標準偏差1の分布に従う母集団から # 10000人サンプリングした値 (param) が # 平均±標準偏差の範囲に全体の68.3%， # 平均±2×標準偏差の範囲に全体の95.5%が含まれる # ことを示したものである。 #・何をしているのか，プログラムを読み解くこと #_______________________________________________________ N <- 10000 mean <- 0 sd <- 1 #平均0，標準偏差1の分布に従う母集団から10000人サンプリング param <- rnorm(N, mean=mean, sd=sd) #分布を確認 hist(param) graphics.off() #平均±標準偏差の範囲と平均±2×標準偏差の範囲を指定 range1 <- c(mean - sd, mean + sd) range2 <- c(mean - 2 * sd, mean + 2 * sd) #全体の何%が，range内に収まるか計算 sum(param > range1[1] & param < range1[2]) / N sum(param > range2[1] & param < range2[2]) / N #【宿題 22】_____________________________________________ #・宿題21を参考にして， # 逸脱行動の変化量は # 平均±標準偏差の範囲に全体の72.5%， # 平均±2×標準偏差の範囲に全体の95%が含まれる # ことを確認すること #_______________________________________________________ x <- datwide$diff xsd <- ssd(x) xmean <- mean(x)