# helper functiont that does all the work
overlap_single<-function(sd,a,b,tar,foil) 
{ 
  nchar(tar)->tarlen
  nchar(foil)->foillen

  if(tarlen!=length(sd)) error("Target Length does not match # of elements in sd");

  ovcalc<-function(sd,len1,len2) # Compute potential overlap of each element from: sd of stimulus, length of stimulus, length of option
  {
    outer(
      1:len1,(1:len2-.5)/len2,  # rescale y centres to 0-1 range
      Vectorize(function(x,y)
        { 
          xloc<-(x-.5)/len1 # rescale x centre
          l<-pnorm(y+.5/len2,xloc,sd[x]/len1)
          r<-pnorm(y-.5/len2,xloc,sd[x]/len1)
          return(abs(l-r))
        }  )
    );
  }

  ovtf<-ovcalc(sd,tarlen,foillen) # for the foil option (target is always stimulus)
  ovtt<-ovcalc(sd,tarlen,tarlen)  # for the correct option (target is always stimulus)

  # identify matching elements
  tfm<-outer(1:tarlen,1:foillen,Vectorize(function(x,y) substr(tar,x,x)==substr(foil,y,y)));  
  ttm<-outer(1:tarlen,1:tarlen,Vectorize(function(x,y) substr(tar,x,x)==substr(tar,y,y))); 

  ffm<-outer(1:foillen,1:foillen,Vectorize(function(x,y) substr(foil,x,x)==substr(foil,y,y))); # foilfoil matches used only to detect repeat

  a_foil<-ifelse(sum(ffm)>nchar(foil),b,a); 
  a_target<-ifelse(sum(ttm)>nchar(tar),b,a);  

  ov_foil<-sum(ovtf*tfm)^a_foil; 
  ov_target<-sum(ovtt*ttm)^a_target; 

  ov_target/(ov_foil+ov_target)
}

overlap<-Vectorize(overlap_single,vectorize.args=c("tar","foil"))

# call overlap like overlap(c(.5,.5,.5,.5,.5),2,3,c("ankle"),c("anxle"))
# parameters are sd(vector),a_nonrepeat,a_repeat,target,foil)
# You can add more target-foil pairs of the same target length
# To do more than one length, you'll need a different sd vector anyway
# Return a vector of P(correct) for each trial

overlap_samediff_single<-function(sd,a,b,thr,tar,reference) 
{ 
  nchar(tar)->tarlen
  nchar(reference)->reflen

  if(tarlen!=length(sd)) error("Target Length does not match # of elements in sd");

  ovcalc<-function(sd,len1,len2) # Compute potential overlap of each element from: sd of stimulus, length of stimulus, length of option
  {
    outer(
      1:len1,(1:len2-.5)/len2,  # rescale y centres to 0-1 range
      Vectorize(function(x,y)
        { 
          xloc<-(x-.5)/len1 # rescale x centre
          l<-pnorm(y+.5/len2,xloc,sd[x]/len1)
          r<-pnorm(y-.5/len2,xloc,sd[x]/len1)
          return(abs(l-r))
        }  )
    );
  }

  ovtr<-ovcalc(sd,reflen,tarlen) # for the reference (target is always stimulus)
#  ovtt<-ovcalc(sd,tarlen,tarlen) # for the target (target is always stimulus)
  # identify matching elements
  trm<-outer(1:tarlen,1:reflen,Vectorize(function(x,y) substr(tar,x,x)==substr(reference,y,y)));  

  ttm<-outer(1:tarlen,1:tarlen,Vectorize(function(x,y) substr(tar,x,x)==substr(tar,y,y))); 

  rrm<-outer(1:reflen,1:reflen,Vectorize(function(x,y) substr(reference,x,x)==substr(reference,y,y))); # refref matches used only to detect repeat

  a_ref<-ifelse(sum(rrm)>reflen,b,a); 
  #a_target<-ifelse(sum(ttm)>tarlen,b,a);  

  ov_different<-thr;#^a_ref; 
  ov_same<-sum(ovtr*trm)^a_ref; 

  ifelse(tar==reference,ov_same,ov_different)/(ov_different+ov_same)
}

overlap_samediff<-Vectorize(overlap_samediff_single,vectorize.args=c("tar","reference"))

# call overlap_samediff like  overlap_samediff(c(.5,.5,.5,.5,.5),2,3,3,"ankle","ankle")
# parameters are sd(vector),a_nonrepeat,a_repeat,soft_threshold,target,reference)
# You can add more target-reference pairs of the same target length
# To do more than one length, you'll need a different sd vector anyway
# Return a vector of P(correct) for each trial

###################################################

#exp 1 data
datafexp1<-read.table("../Exp1/datashortExp12AFC.txt")

subset(datafexp1,V7==7)->exp1tar7
exp1tar7$V5->exp1tar7tar
exp1tar7$V6->exp1tar7foil

# call overlap like overlap(c(.5,.5,.5,.5,.5),2,3,c("ankle"),c("anxle"))
overlap(c(.5,.5,.5,.5,.5,.5,.5),2,3,c(as.character(exp1tar7tar)),c(as.character(exp1tar7foil)))
overlap(c(.5,.5,.5,.5,.5,.5,.5),2,3,c("dartien"),c("drartien"))

## call overlap like overlap(c(.5,.5,.5,.5,.5),2,3,c("ankle"),c("anxle"))
# parameters are sd(vector),a_nonrepeat,a_repeat,target,foil)

#create a function that runs the overlap for all target lengths,combines all data, calculates sse and 
#includes a summary


exp1fitOV<- function(p,summary=0){
  
  a<-p[1]
  b<-p[2]
  #sd7<-p[3:9]
  #sd8<-p[10:17]
  d<-p[3] #new changes; update the number of expected number of parameters as well.
  r<-p[4]
  #d=1.5;r=1.2
  sd7<-d*(1-exp(-(1:7-.5)/r))
  sd8<-d*(1-exp(-(1:8-.5)/r))
  if(any(c(sd7,sd8)<0)) return(1e+16)
  
  subset(datafexp1,V7==7)->tar7
  tar7$V5->tar7tar
  tar7$V6->tar7foil
  subset(datafexp1,V7==8)->tar8
  tar8$V5->tar8tar
  tar8$V6->tar8foil
  overlap(sd7,a,b,as.character(tar7tar),as.character(tar7foil))->overlap7
  overlap(sd8,a,b,as.character(tar8tar),as.character(tar8foil))->overlap8
  c(overlap7,overlap8)->pc
  
  sse<-sum((datafexp1$V2-pc)^2)
  
  if(summary>0)
  {
    tempd<-datafexp1
    tempd$V2<-pc
    
    list(fit=sse,
         summary=rbind(data.frame(src="model",tempd),
                       data.frame(src="data",datafexp1))
    )
  }
  else
  {
    sse
  }
  
}


optim(c(2,3,1.5,1.2),
      fn=exp1fitOV,control=list(maxit=5000,trace=T))->exp1ov


exp1ov$par

#optim(exp1ov$par,
#      fn=exp1fitOV,control=list(maxit=50000,trace=T))->exp1ov2

#Exiting from Nelder Mead minimizer
#12532 function evaluations used

round(exp1ov$par,3)

exp1fitOV(exp1ov$par,summary=1)$summary->ovpredictionsexp1

with(subset(ovpredictionsexp1,src=="model"),xtabs(V2~V3+V7)/xtabs(~V3+V7))
with(subset(ovpredictionsexp1,src=="data"),xtabs(V2~V3+V7)/xtabs(~V3+V7))



#exp 4 data

datafexp4<-read.table("../Exp4/datashortExp4SD.txt")#specify data file

# call overlap_samediff like  overlap_samediff(c(.5,.5,.5,.5,.5),2,3,3,"ankle","ankle")
# parameters are sd(vector),a_nonrepeat,a_repeat,soft_threshold,target,reference)
# You can add more target-reference pairs of the same target length
# To do more than one length, you'll need a different sd vector anyway
# Return a vector of P(correct) for each trial

overlap_samediff(c(.5,.5,.5,.5,.5,.5,.5,.5),2,3,3,"oleluvan","olebyvan")

exp4fitOV<- function(p,summary=0){
  
  a<-p[1]
  b<-p[2]
  #sd<-p[3:10]
  d<-p[3] #new  
  r<-p[4]
  #d=1.5;r=1.2
  sd<-d*(1-exp(-(1:8-.5)/r))
  #thr<-p[11]
  thr<-p[5]
  
  if(any(sd<0)) return(1e+16)
  
  datafexp4$V5->tar
  datafexp4$V6->ref
  
  overlap_samediff(sd,a,b,thr,as.character(tar),as.character(ref))->pc
  
  sse<-sum((datafexp4$V2-pc)^2)
  
  if(summary>0)
  {
    tempd<-datafexp4
    tempd$V2<-pc
    
    list(fit=sse,
         summary=rbind(data.frame(src="model",tempd),
                       data.frame(src="data",datafexp4))
    )
  }
  else
  {
    sse
  }
  
}



optim(c(7.5,7.5,1.2,1.7,3651),
      fn=exp4fitOV,control=list(maxit=5000,trace=T))->exp4ov


exp4ov$par

#optim(exp4ov$par,
      #fn=exp4fitOV,control=list(maxit=50000,trace=T))->exp4ov2


#exp4fitOV(exp4ov2$par,summary=1)$summary->ovpredictionsexp4
exp4fitOV(exp4ov$par,summary=1)$summary->ovpredictionsexp4

with(subset(ovpredictionsexp4,src=="model"),xtabs(V2~V3+V4+V8)/xtabs(~V3+V4+V8))
with(subset(ovpredictionsexp4,src=="data"),xtabs(V2~V3+V4+V8)/xtabs(~V3+V4+V8))


#exports

#export OV predictions means Exp1
write.csv(ovpredictionsexp1,"../OVEXP1rd.txt",quote=FALSE,row.names =FALSE)

#export OV predictions means Exp4
write.csv(ovpredictionsexp4,"../OVEXP4rd.txt",quote=FALSE,row.names =FALSE)
