階層化したルール

• 昨日の記事で階層化したルールに基づく順序が正単体空間で折れ線になる話しを書いた
• 線形代数的にはどう書けばよいだろうか？
• 複数のルールは正単体空間座標との一次線形式で表されるとすれば、複数のルールを行列の演算で表すことができる
• ルールが階層化しているというのは、ルールの適用順序があって、先のルールの結果に依存して次のルールの適用結果が決まる、ということ
• 特に、「決断」の場合には是か非かのブーリアンだから、行列で表されたすべてのルールの評価結果をブール値にして、そこにブール演算を入れればよいことがわかる
• やってみる

# number of acts
k <- 3
# number of states
n <- 4
# true.prob
library(MCMCpack)
true.prob <- rdirichlet(k,rep(100,n))
# number of iterative observations
n.iter <- 10000

# history of observations
history <- array(0, c(n.iter,k,n))
# initial information
history[1,,] <- 0

# judgement rules
# mは正単体空間座標を行ベクトルとする行列
# xは複数の判断ルールを表す１次線形係数を列にする行列
rules <- function(m,x){
	# mの各点のxの各行列における評価値
	mx <- m %*% x
	#print(mx)
	# 評価結果を各ルールについて0,1化する
	tmp <- matrix(0,length(mx[,1]),length(mx[1,]))
	for(i in 1:length(x[1,])){
		tmp2 <- which(mx[,i] == max(mx[,i]))
		tmp[tmp2,i] <-1 
	}
	# 上位ルールから順に"&"適用
	tmp3 <- apply(tmp,1,cumprod)
	#print(tmp3)
	tmp4 <- apply(tmp3,2,sum)
	which(tmp4 == max(tmp4))
}
m <- matrix(runif(12),3,4)
x <- matrix(c(1,1,0,0,1,0,0,0,0,0,1,0),nrow=4)
rules(m,x)

n.pt <- 10
for(i in 2:n.iter){
	history[i,,] <- history[i-1,,]
	rs <- list()
	for(j in 1:k){
		rs[[j]] <- rdirichlet(n.pt,history[i-1,j,]+1)
	}
	selected <- rep(0,k)
	for(j in 1:n.pt){
		tmp <- matrix(NA,k,n)
		for(jj in 1:k){
			tmp[jj,] <- rs[[jj]][j,]
		}
		tmp2 <- rules(tmp,x)
		selected[tmp2] <- selected[tmp2]+1
	}
	#print(selected)
	selected.option <- sample(1:k,1,prob=selected/sum(selected))
	selected.state <- sample(1:n,1,prob=true.prob[selected.option,])
	history[i,selected.option,selected.state] <- history[i,selected.option,selected.state] + 1
}

#history

history.2 <- history[,1,]
for(i in 2:k){
	history.2 <- cbind(history.2,history[,i,])
}
par(mfcol=c(1,2))
matplot(history.2,type="l")
#plot(apply(history.2[,c(1,2,5,6,9,10)],1,sum))
#abline(0,max(apply(true.prob[,1:2],1,sum)))


plot(apply(history.2[501:n.iter,c(1,2,5,6,9,10)],1,sum))
abline(min(apply(history.2[501:n.iter,c(1,2,5,6,9,10)],1,sum)),max(apply(true.prob[,1:2],1,sum)))