チューニングする

  • こちらの記事の最初の図の2x4個のヒストグラムのうち、上段右端のものが、1峰性なのかどうかを確かめたい
  • 十分な試行回数ができているか
  • ヒストグラムがときとして、複数の得点を合算してバーにすることがあるが、今は、1点違いを確実に確認したい
  • 変動可能なパラメタを引数化したい
  • 試行回数はtrials変数
  • ヒストグラムの刻みは"breaks"オプション
# データをまず格納して
hhh<-hist.data(trials,batter,i,Ninning,Nbase)
# 刻みは0からデータの最大数までのすべての整数にする
hist(hhh,col="pink",breaks=0:max(hhh))
  • こちらの記事で引数化されていないパラメータは、"9"イニング数、"3"ベース数(あとは、選手数=9だが、ソースがこの値依存で作ってあるのと、バッター全員の打率が等しいとして実施しているので、これは、いじらず、イニング数Ninning、ベース数Nbaseのみを導入する
  • 打率も比較的きれいな値にしてやる
  • 以下の条件で(掲載図の上段、左から3番目で、0と5−10の間あたりにピークありと読む
Ninning<-3
Nbase<-5
out.count<-3

http://www.genome.med.kyoto-u.ac.jp/StatGenet/lectures/2010/a.jpeg

one.game.score<-
        function(batter,out.count,Ninning,Nbase){                   # 変数としてチェンジまでのアウトカウントもいじくれる
          si  <- c(1);dou <- c(1,0);tri <- c(1,0,0);hr  <- c(1,0,0,0)
          out.count<- out.count
          
          #total.score<- rep(0,9)
          total.score<- rep(0,Ninning)
          batter.box<- 1
          #for(t in 1:9){
          for(t in 1:Ninning){
            runner<- rep(0,Ninning)
            out<- 0
            repeat{
              x<- sample(c(1,2,3,4,5),prob=batter[batter.box,],size=1)
              switch(x,
                     (out<- out + 1),
                     (runner<- append(runner,si)),
                     (runner<- append(runner,dou)),
                     (runner<- append(runner,tri)),
                     (runner<- append(runner,hr))
              )
              switch(batter.box,
                     (batter.box<- 2),(batter.box<- 3),(batter.box<- 4),(batter.box<- 5),(batter.box<- 6),(batter.box<- 7),(batter.box<- 8),(batter.box<- 9),(batter.box<- 1)
              )
              if(out>(out.count - 1)){
                break
              }
            }
            #total.score[t]<- sum(runner[c(1:(length(runner)-3))])
            total.score[t]<- sum(runner[c(1:max(1,(length(runner)-Nbase)))])
          }
          return(sum(total.score))
        }

hist.data<-
function(n,batter,out.count,Ninning,Nbase){                               # n試合
  data1<- rep(0,n)                                          # batterは5行9列の打撃確率行列
  for(i in 1:n){
    data1[i]<- one.game.score(batter,out.count,Ninning,Nbase)
  }
  result.count<- rep(0,(max(data1) + 1))
  for(p in 0:max(data1)){
    result.count[p]<- length(which(data1 == p))
  }
  #print(result.count/n)                            # n試合したときの各得点の割合が返る 
  #return(histogram(data1))                         
  #return(result.count/n)                           
  return(data1)                                     # 得点の生データを返す
}

#batter<- matrix(c(0.9,0.00,0.00,0.00,0.1),9,5,byrow=T)
#title.name<- c("out.count 1","out.count 2","out.count 3","out.count 4","out.count 5","out.count 6","out.count 7","out.count 8")
#xlab<- "Score"

Ninning<-3
Nbase<-5
batter<-matrix(c(0.4,0.2,0.2,0.1,0.1),9,5,byrow=T)
#out.count<-4

trials<- 10000
par(mfrow=c(2,4))
for(i in 1:8){
	hhh<-hist.data(trials,batter,i,Ninning,Nbase)
  hist(hhh,col="pink",breaks=0:max(hhh))
}