認知情報解析B ALCOVE

# 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));

Leave a Reply