野球 確率の計算

• 前日の続き（こちら）
• 得点と確率のプロットを追加した
• 相変わらずヒットの確率を全員同じにして単純化している
• ヒットの種類は4種類に限定している
  • こちらのようにヒットの種類を一般化できていない
• 仮定など
  • p:ヒットの確率（４塁打＝HRまで）
  • q:アウトの確率
  • Nb:baseの数
  • Nout:1イニングのアウト数
• 計算のために定義したもの
  • x:配列
    • x1:進塁状況を表した{1,0}のベクトルの入ったリスト
    • x2:ヒットの確率を掛け合わせた確率をおさめたベクトル
  • score(v,Nb):関数
    • Nbベースの時の得点を返す
  • A:行列　xの各要素について、スコアとその確率を並べたもの
  • B:行列　スコアとその確率　（Aをスコアごとに確率を総和したもの）
• 最終的なグラフは...
  • 1イニングの得点
  • 試合の総得点は1イニングの得点から計算できる
  • ただし規格化していない
    • 和は１でない
    • ある程度の確率で打ち切り（Nの回数による）

p<-c(0.3,0.2,0.1,0.05)   #ヒットの確率
q<-1-sum(p)    #アウトの確率

a<-list(list(c()),1)   #初期条件
b<-list(list(c(1)),c(p[1]))
c<-list(list(c(1,0),c(1,1)),c(p[2],p[1]*p[1]))
d<-list(list(c(1,0,0),c(1,0,1),c(1,1,0),c(1,1,1)),c(p[3],p[2]*p[1],p[1]*p[2],p[1]^3))
N<-10   #漸化式を計算する回数

x<-list(c(0,b[[1]],c[[1]],d[[1]]),c(1,b[[2]],c[[2]],d[[2]]))
for (i in 1:N){
	
	a1<-lapply(a[[1]],append,c(1,0,0,0),after=FALSE)
	b1<-lapply(b[[1]],append,c(1,0,0),after=FALSE)
	c1<-lapply(c[[1]],append,c(1,0),after=FALSE)
	d1<-lapply(d[[1]],append,c(1),after=FALSE)
	a2<-a[[2]]*p[4]
	b2<-b[[2]]*p[3]
	c2<-c[[2]]*p[2]
	d2<-d[[2]]*p[1]
	
	u<-list(c(a1,b1,c1,d1),c(a2,b2,c2,d2))  
	a<-b
	b<-c
	c<-d
	d<-u
	x<-list(c(x[[1]],u[[1]]),c(x[[2]],u[[2]]))
	}
#x

#得点を数える関数score(v,Nb)を作る
Nb <-3   #baseの数

score <- function (v,Nb=Nb){
	if ( length(v) > Nb){
		return(sum(v[1:(length(v)-Nb)]))
		}else{
			return(0)
			}
	}

Nout<-3 #1イニングのアウト数
A<-matrix(0,2,length(x[[1]]))
for(i in 1:length(x[[1]])){
	A[1,i]<-score(x[[1]][[i]],Nb)
	A[2,i]<-choose(sum(x[[1]][[i]])+Nout-1,Nout-1)*q^3*x[[2]][[i]]
	}

B<-matrix(0,2,max(A[1,])+1)
for (i in 0:max(A[1,])){
	B[1,i+1]<-i
	numi<-which(A[1,]==i)
	B[2,i+1]<-sum(A[2,][numi])
	}
plot(t(B))