階級数を変えてヒストグラムを描く関数
ヒストグラムは図のように、階級数の違いによって、分布の概観がかなり異なってみえる。この事例では階級数が13の場合は正規分布のように見えるが、階級数が33の場合は右側に盛り上がりがあるようにみえる。
どのように階級を設定すべきかについては、決定的なものはないが、一般的に良く使われている階級幅はスタージェス(Sturges)の公式と呼ばれるものから計算したもので、データ数をN、階級数をLしたときに
で計算されるものである。ここで、floor(x)は実数xに対してx以下の最大の整数を与える関数の意味で用いている。Rのデフォルトの階級数もこの設定である。一方、探索的データ解析では、階級数の最大値として、
を推奨している。この方法はデータ数が少ない場合に、より多めの階級数を取ることになる。いずれにしても最適な階級数があるわけでゃなく、階級数を変化させて分布形状を調べるのが良いとされているようである。この探索的データ解析の方法をデフォルトとして、階級数をかえてヒストグラムを描くRの関数を作成した。
#----------------------------------- # 階級数を変えてヒストグラムを求める関数 #----------------------------------- exhist <- function( x, #xはデータベクトル n=NULL, # 階級数の指定 ...) # hist に引き渡す任意の引数 { N <- length(x) #データ数を求める scale_n <- floor(10*log10(N)) #階級数を求める #階級数が与えられていたら if(!is.null(n)){ scale_n <- n } digits_n <- max(nchar(x-trunc(x))) #有効桁数を求める if (digits_n > 2){ digits_n <- digits_n -2 }else{ digits_n <- 0 } #階級幅を求める M <- round((max(x)-min(x))/scale_n,digits=digits_n) #スタートポイントとエンドポイントを求める SP <- round((min(x)-M/2),digits=digits_n) EP <- round((max(x)+M/2),digits=digits_n) #階級ベクトルを設定する brk=seq(SP,EP,length=scale_n+1) #ヒストグラムを描く hist(x,breaks=brk,...) #階級ベクトルを返す return(brk) }
ベイズの定理を使って「オオカミ少年」のシミュレーションをしてみた
松原望「意思決定の基礎」に、オオカミ少年が嘘つきであるという確信度の変化をベイズの定理を使って説明している章がある。おもしろそうだったので、この話をR言語を使ってシミュレーションしてみた。
この話は、「オオカミが来た!」という宣言が「嘘であった」()、「本当だった」()とし、元々「この少年が嘘つきである」とする確信度をとしたとき、嘘が続いたり、嘘と本当が交互に表れたりした時に、「この少年は嘘つきだ!」という確信度がどのように変化するかというシミュレーションである。
準備としては、最初の確信度は1/2であるとする。つまり半信半疑であるとする。さらに下表のように、この少年が嘘つきなら、本当の事を言う確率はであり、正直ものならば、嘘をつく確率はであるとする。
嘘であった | 本当だった | |
---|---|---|
この少年が嘘つきである | 3/4 | 1/4 |
この少年は正直者である | 1/4 | 3/4 |
この時、最初に少年が「オオカミが来た!」と言った宣言が「嘘だった」とすると、元々この少年が嘘つきである確率は
ランダムにデータを発生させて、この確率がどのように変化するかを見たのが左の図である。そして、そのRコードが以下である。
#----------------------------------- # 狼少年シミュレーション #----------------------------------- # 判断確率のデータを与える(これは当初から与えるデータ) # # 嘘だった(b1) 本当だった(b2) # ┌──────┬──────┐ # 嘘つき(t1)│ 3/4 │ 1/4 │ # ├──────┼──────┤ # 正直 (t2) │ 1/4 │ 3/4 │ # └──────┴──────┘ Pb1t1 <- 3/4 #嘘つきで、実際に嘘ついた確率 Pb2t1 <- 1/4 #嘘つきなのに、実際は本当の事を言った確率(つまり間違い) Pb2t2 <- 3/4 #正直者で、実際に本当の事を言った確率 Pb1t2 <- 1/4 #正直者なのに、実際は嘘ついた確率(つまり間違い) #シュミレーション回数 rep_n <- 50 # 嘘つきであると思う確信度を表す数値 dgree of belief dob <- 1/2 # rep_n回数分の事象データを発生させる # 1:嘘だった(b1) 2:本当だった(b2) # 3回に2回は嘘をつくもの(prob=c(2,1))としてデータを発生させている。 evnt <- sample(1:2,rep_n,rep=T,prob=c(2,1)) #事象毎に確信度を変えながら計算していく for ( i in 1:rep_n){ if (evnt[i] == 1) { dob[i+1] <- (Pb1t1 * dob[i] ) / (Pb1t1 * dob[i] + Pb1t2 * (1-dob[i])) } else { dob[i+1] <- (Pb2t1 * dob[i]) / (Pb2t1 * dob[i] + Pb2t2 * (1-dob[i])) } } plot(dob,type="l",ylim=c(0,1))
10回程度で確信度が1、つまり「完全にこの少年は嘘つきだ!」という結論になっている。しかし、何度も繰り返してみると、結構振幅が発生する場合もある。つまり「本当だった」という事象が続いた場合である。また、一度確信度が上がると、なかなか下がらない傾向もみえる。
ネットワーク分析の面白さ
- たまたま見つけた記事ですが、恋愛関係ネットワークを可視化した「ジェファーソン高校恋愛構造図」って面白いね。やるな〜。思いっきり遊べる研究ですね。
- その他、こんな論文も・・・「SNS における関係形成原理−mixi のデータ分析−」
- さらに、こんなブログもあった・・・ナウシカをネットワーク分析する。 2004年頃の記事らしいが、面白いですね。
物語エンジン構想
物語のストーリー展開には、キッカケとなる変化が必要。それが活性点をつくり、新たなストーリーラインが浮かび上がってくる。なので、時間軸にしたがった記憶部分と過去の膨大な物語の構造のデータベースがあり、それに新しい変化が入力され、過去の記憶とパターン照合する事で、あたかも画像が浮かび上がってくるように、活性化ポイントの変化・ストーリーラインの候補が浮かび上がってくる。そして、それらの候補からどれをクローズアップするかを意思決定すれば、その意思決定した結果が、再び記憶に蓄積されていく。
てな事を考えてみている。でも、物語はどんどんと過去を書き換えないと意味ないなとも思う。過去の事象をどのように付置するかが物語りのポイントだと思うので、過去・歴史の再構成みたいなもので・・・