# function to initialize ALCOVE's parameter set
ALC.init<-function() {
stimType='nom' # stimType
c=2 # gain
phi=5 # decision strength
lrA=0.1 # learning rate for attentions
lrW=0.1 # learning rate for associations
return(data.frame(stimType,lrA,lrW,c,phi))
}
# main function
alcove<-function(parmSet,inp,targ,iter) {
# ----ALCOVE for R ---
# input arguments
# parmSet - parameter set
# inp - input matrix (n_sample x n_dimension)
# targ - target matrix (n_sample x n_category)
# iter - # of training epochs
# ----ALCOVE for R ---
# initialization
inpSize=dim(inp)
targSize=dim(targ)
alpha=matrix(1,nrow=1,ncol=inpSize[2])/inpSize[2]
w=matrix(rnorm(inpSize[1]*targSize[2])*0.1,ncol=inpSize[1])
accu=rep(0,nrow=iter+1)
attn=matrix(0,nrow=iter+1,ncol=inpSize[2])
attn[1,]=alpha
# end initialization
for (i_iter in 1:iter) {
ro=sample(1:inpSize[1],inpSize[1])
prob_temp=0;
for (i_tr in 1:inpSize[1]) {
if (parmSet$stimType=='nom') {
diff= matrix(as.numeric(matrix(1,inpSize[1],1)%*%inp[ro[i_tr],]!=inp),nrow=inpSize[1])
} else { diff=inp[ro[i_tr],]-inp }
exemp=exp(-parmSet$c*(diff%*%t(alpha)))
out=w%*%exemp
err=targ[ro[i_tr],]-out
delta_W=parmSet$lrW*exemp%*%t(err)
delta_A=-parmSet$lrA*(t(err)%*%w*t(exemp))%*%diff*parmSet$c
w=w+t(delta_W)
alpha=alpha+delta_A
alpha[which(alpha<0)]=0
pT=(exp(parmSet$phi*out)/sum(exp(parmSet$phi*out)))*targ[ro[i_tr],]
prob_temp=prob_temp+pT[which(!pT==0)]
}
accu[i_iter+1]=prob_temp/targSize[1]
attn[i_iter+1,]=alpha
}
attnN=attn/apply(attn,1, sum)
out=matrix(0,nrow=targSize[2],ncol=inpSize[1])
for (i_tr in 1:inpSize[1]) {
if (parmSet$stimType=='nom') {
diff= matrix(as.numeric(matrix(1,inpSize[1],1)%*%inp[i_tr,]!=inp),nrow=inpSize[1])
} else { diff=inp[i_tr,]-inp}
exemp=exp(-parmSet$c*(diff%*%t(alpha)))
out[,i_tr]=w%*%exemp
}
return(list(alpha=alpha,w=w,attn=attn,attnN=attnN,accu=accu,out=out,ps=parmSet))
}
##################################################
# example
# カテゴリー学習モデル:ALCOVE
# medin & schaffer 1978 のシミュレーション
##################################################
inp=matrix(c(1, 1, 1, 0,
1, 0, 1, 0,
1, 0, 1, 1,
1, 1, 0, 1,
0, 1, 1, 1,
1, 1, 0, 0,
0, 1, 1 ,0,
0, 0, 0, 1,
0, 0, 0, 0),nrow=9,byrow=T)
targ=matrix(c(1, 0,
1, 0,
1, 0,
1, 0,
1, 0,
0, 1,
0, 1,
0, 1,
0, 1),nrow=9,byrow=T)
parmSet<-ALC.init()
result<-alcove(parmSet,inp,targ,30)
plot(result$accu, type="o", col="black",ylim=c(0,1.1),
xlab="training", ylab="Proportion", cex.lab=1.4)
lines(result$attnN[,1], type="o", pch=22, lty=2, col="blue")
lines(result$attnN[,2], type="o", pch=23, lty=3, col="red")
lines(result$attnN[,3], type="o", pch=24, lty=4, col="green")
lines(result$attnN[,4], type="o", pch=25, lty=5, col="cyan")
title(main="ALOCVE: Learning MS (1978) 5-4 Stimulus Set ")
legend("topleft", c("Accuracy","AttnD1","AttnD2","AttnD3","AttnD4"),
cex=1,col=c("black","blue","red","green","cyan"), pch=c(21:25), lty=c(1:5));
Related