ホーム‎ > ‎

TIPS

ここでは、何か作ったものなどを公開したいと思っています。

1. エクセルで箱ひげ図作図シート
    エクセルで箱ひげ図を作成するシートです。xlsx形式です。
    ご自由にお使い頂ければ幸いですが、私はなんの責任も負えません。
    このシートは以下のサイトや記事などを参考に作成しました。

  
     (参考にさせていただいてありがとうございます)
    最新版(ちゃんとしたversion)ダウンロードは以下からどうぞ(右側下矢印のマーク)。

    このようなRライクなものが数値を入力するだけでできます。
    

    *残念ながらこのままでは負の数値を含む作図ができません。(エクセルの仕様上難しいのです)
    *Rのパッケージにあるように、外れ値は書きません。
       また、髭の一番上が最大値、箱の上部が75%タイル、真中が中央値、下部が25%タイル、髭の一番下が最小値となります。
      Rやその他のものとは書き方が異なる可能性があります。
       (慣習上、書き方には数種類あります) 
    
    【注意】
    前のヴァージョンver. 1.1は完全に誤った図が作成されます。修正したver. 1.2を公開しましたので、
    「必ず」差し替えて下さい。ダウンロードして下さった方々、大変申し訳ございませんでした。
    
 

2. エクセルで平均値補助線つき散布図テンプレート
    エクセルで以下のような平均値を直線で表す散布図を作るテンプレートです。
    これも同様に、ご自由にお使い頂ければ幸いですが、私はなんの責任も負えません。    
    補助線及び対角線を数値を入力するだけで簡単に作図できます。
    下からダウンロードできます。
    
    
  

    2012/12/21

3. TIPS集
    エクセルで以下のような「全然大したことないけれどもいちいちその度に作ってたらちょっと面倒な事」ができます。
  1.     既知の相関係数とサンプルサイズから無相関検定のp値を得る
  2.     実験などで使う文字列の基本的情報を得る(文字数、語数等)
  3.     サンプルの外れ値の上限・下限を得る
  4.     外れ値の条件と処置の仕方を結果を見ながら決める
  5.     ηp2を計算する
  6.     基本的な棒グラフや折れ線グラフを描く
    例(外れ値)


    これも同様に、ご自由にお使い頂ければ幸いですが、私はなんの責任も負えません。    
    下からダウンロードできます。

    2012/12/21

4. 相関係数+α計算シート

相関係数に関わるちょっとした事ができます。
  1. 無相関検定
  2. 母相関係数の区間推定
  3. 相関係数の希薄化の修正
   

   これも同様に、ご自由にお使い頂ければ幸いですが、私はなんの責任も負えません。    
    下からダウンロードできます。

    2012/2/26

5. 自動的に欠席者分に空行を入れるエクセルマクロ



欠席者に空行, 例1

*A列にIDが入っていて,更に周回しない場合。つまり,1クラスのみ。

Sub kesseki()
    Dim maxrow As Long
    Dim i As Long
    maxrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For j = 1 To 10
    For i = maxrow To 2 Step -1
        If Cells(i + 1, 1) - Cells(i, 1) >= 2 Then
            Rows(i + 1).Insert
            Cells(i + 1, 1) = Cells(i, 1) + 1
        End If
    Next i
    Next j
End Sub

欠席者に空行,例2

*C列にIDが入っていて,更に複数クラスが入っている場合。

Sub kesseki()
    Dim maxrow As Long
    Dim i As Long
    maxrow = Cells(Rows.Count, 3).End(xlUp).Row
    
    For j = 1 To 10
    For i = maxrow To 2 Step -1
        If Cells(i + 1, 3) - Cells(i, 3) >= 2 Then
            Rows(i + 1).Insert
            Cells(i + 1, 1) = Cells(i, 1)
            Cells(i + 1, 2) = Cells(i, 2)
            Cells(i + 1, 3) = Cells(i, 3) + 1
        ElseIf (Cells(i + 1, 3) = 2) And Not (Cells(i, 3) = 1) Then
            Rows(i + 1).Insert
            Cells(i + 1, 1) = Cells(i + 2, 1)
            Cells(i + 1, 2) = Cells(i + 2, 2)
            Cells(i + 1, 3) = 1
        Else
        End If
    Next i
    Next j
End Sub

6. ジャックナイフを用いた相関係数計算シート

相関係数のジャックナイフ推定値がエクセルで計算出来ます。
どのデータを外せば,相関係数が上がるかも確認できます。



7. 形態素習得研究で使うグループスコアメソッドをリサンプリングするRのスクリプト

詳しくは,こちらの資料で。


rGSM

rGSM <- function(x, n.boot, n.sub)
{
meany = numeric(0)
for(i in 1:n.boot)
{
subs <- x[sample(nrow(x),n.sub,replace=TRUE),]
y[i] <-(c(57.29578*(asin(sqrt((sum(subs[,1])/sum(subs[,2])))))))
meany[i] <-mean(y)
}
par(mfrow=c(1,3))
boxplot(y, ylab="score") 
plot(meany, xlab="", ylab="score")
hist(y, ylab="frequency", xlab="score", main="")
list("summary"=summary(y),"95%CI"=quantile(y,p=c(0.025,0.975)))
}


使い方は,上記をそのままRのコンソールにコピペしてください。

< rGSM(a, b, c)

この関数は,という三つの引数を取ります。
aは,2列のデータです。一列目は,各被験者の正用の数,二列目は義務的文脈の数です。
bは,ブートストラップの試行回数。
cは,subsetのデータ数です。
各試行における正用率は逆正弦変換します。

rGSM(x, 1000, 10)

なら,xという変数に入ったデータに対して,10個からなるsubsetを1000回ブートストラッピングします。
コンソールには,結果が表示されます。結果は,記述統計と95%CIです。
図示は,以下のようなものです。



    2013/7/16


8. 相関係数を考慮したdを変換するRのスクリプト

スクリプト

D2Dr <- function(d, r)
{
dr <- d/sqrt(2*(1-r))
list("d not-considering correlation"=d, "r"=r, "d considering correlation"=dr)
}
Dr2D <- function(dr, r)
{
d <- dr*sqrt(2*(1-r))
list("d not-considering correlation"=d, "r"=r, "d considering correlation"=dr)
}

9. 標本サイズ決定シート

 目標とする信頼区間の幅と標準偏差から標本サイズを決定する方法,許容誤差と母比率から標本サイズを決定する方法について簡単に計算できるエクセルシートを公開しました。


          2014/7/31


10. 効果量の信頼区間から標本サイズ決定シート   

目標とする効果量とその信頼区間の幅から標本サイズを決められる。



11. WMXの分析 

詳しくはこちら。


WMX分析

#WMX_R関数(2014/12/19)
#ver.β(0.90)草薙邦広・阿部大輔・川口勇作


#【語数の数え上げ】
tswordcount = function(datapoints,maxtime,filename = "") {
if (maxtime%%datapoints != 0) {
print("分数がデータポイント数で割りきれません。")
return
}
mytable = read.table(file.choose(),sep="\t",quote="",skip=1)[,3:4]
colnames(mytable) = c("time_ms","text")
for(i in 1:nrow(mytable)) {
mytable$time_min[i] = floor(mytable$time_ms[i]/1000/60)
if(mytable$text[i] == "@" || mytable$text[i] == "*" || mytable$text[i] == "") {
mytable$num_words[i] = 0
} else {
mytable$num_words[i] = sapply(gregexpr("\\W+", mytable$text[i]), length)
}
}
table_last = mytable[nrow(mytable),]
interval = maxtime/datapoints
time_min = 0
words = 0
for(i in 1:datapoints) {
time_min[i] = interval*(i-1)
if(interval*(i-1) <= table_last$time_min) {
if(interval*(i-1) %in% mytable$time_min){
words[i] = mytable[mytable$time_ms == min(mytable[mytable$time_min == time_min[i],]$time_ms),]$num_word
} else {
if(i == 0) {
words[i] == 0
}else{
words[i] = words[i-1]
}
}
} else {
words[i] = table_last$num_words
}
}
newtable = data.frame("time_min" = time_min, "words" = words)
if (filename != "") {
write.table(newtable,filename,append=F,col.names=T, row.names=F,sep="\t")
}
return(newtable)
}

#【WMX分析関数】
wmxanalysis<-function(dat){
d<-dat[,2]
d2<-numeric(0)
#累積データを解く
for(i in 1:(length(d)-1)){
d2[i]<-d[i+1]-d[i]
if(d2[i]<0){
d2[i]<-0
}else{
}
}
d2[length(d)]<-0
#ポアソン分布モデル
lambd <- sum(d2*(0:(length(d2)-1)))/sum(d2) #λの算出
expe<-ppois(1:length(d),lambda=lambd) #確率化
pd<-d/d[length(d)] #期待値
chisq<-sum((pd-expe)^2/expe)#カイ二乗値
#線形モデル
intercept<-lm(dat[,2]~dat[,1])[[1]][[1]] #切片
rsq<-cor(dat)[2]^2 #決定係数
slope<-lm(dat[,2]~dat[,1])[[1]][[2]] #傾き
#出力
list("The total number of words"=d[length(d)],"Lambda"=lambd,"DataPoints"=length(d2),"Observation"=(d2),"Cumulative"=dat[,2],"chi-squred"=chisq,"intercept"=intercept,"slope"=slope,"R^2"=rsq)
}


#【ポアソン分布モデルの可視化(おまけ)】
poisplot<-function(lmbd,maxmin,cumulative=TRUE){
if(cumulative==TRUE){
plot(ppois(1:maxmin, lambda=lmbd), ylab="Density", xlab="Time", main="Model")
}else{
plot(dpois(1:maxmin, lambda=lmbd), ylab="Density", xlab="Time", main="Model")
}
}

#【WMXプロット】
wmxplot<-function(dat){
par(mfrow=c(2,3))
d<-dat[[5]]
plot(dat[[4]],main="Observations",xlab="Time",ylab="Words",type="b")#観測値
plot(d,ylab="Density",xlab="Time",main="Observations and Models (Cumulative)")#累積観測値
lines(ppois(1:length(d),dat[[2]])*dat[[1]],col="blue")#ポアソン分布モデル
abline(dat[[7]],dat[[8]],col="red")#線形モデル
plot(d-ppois(1:length(d),dat[[2]])*dat[[1]], main="Residuals (Poisson)",ylab="Residuals",xlab="Time") #ポアソン残差
dlm<-dat[[8]]*1:length(d)+dat[[7]]#線形モデルの期待値
plot(d-dlm, main="Residuals (LM)",ylab="Residuals",xlab="Time")#線形モデル残差
hist(d-ppois(1:length(d),dat[[2]])*dat[[1]], main="Histgram of Residuals (Poisson)",ylab="Residuals",xlab="Time",col="lightgray")#ポアソン分布モデル残差の度数分布
hist(d-dlm, main="Histgram of Residuals (LM)",ylab="Residuals",xlab="Time",col="lightgray")#線形モデル残差の度数分
}


#【全部一気に】
wmx<-function(a, b){wmxplot(wmxanalysis(tswordcount(a,b)))}


    不都合、不具合、要望などがありましたら私までご連絡下さい。
    kusanagi [at] nagoya-u.jp
ċ
PoD.txt
(2k)
Kunihiro Kusanagi,
2015/01/28 1:43
Ĉ
Kunihiro Kusanagi,
2012/12/21 0:34
ċ
WMX_R関数β(ver, .090).r
(3k)
Kunihiro Kusanagi,
2015/01/28 23:17
Ĉ
Kunihiro Kusanagi,
2014/02/19 4:14
Ĉ
Kunihiro Kusanagi,
2014/07/30 23:58
Ĉ
Kunihiro Kusanagi,
2013/02/14 5:21
Ĉ
Kunihiro Kusanagi,
2013/07/16 3:16
Ĉ
Kunihiro Kusanagi,
2014/02/19 3:51