R/OASA.R

In LHD: Latin Hypercube Designs (LHDs)

#' Orthogonal-Array-Based Simulated Annealing
#'
#' \code{OASA} returns an LHD matrix generated by orthogonal-array-based simulated annealing algorithm (OASA)
#'
#' @param OA An orthogonal array matrix.
#' @param N A positive integer, which stands for the number of iterations. The default is set to be 10. A large value of \code{N} will result a high CPU time, and it is recommended to be no greater than 500.
#' @param T0 A positive number, which stands for the user-defined initial temperature. The default is set to be 10.
#' @param rate A positive percentage, which stands for temperature decrease rate, and it should be in (0,1). For example, rate=0.25 means the temperature decreases by 25\% each time. The default is set to be 10\%.
#' @param Tmin A positive number, which stands for the minimium temperature allowed. When current temperature becomes smaller or equal to \code{Tmin}, the stopping criterion for current loop is met. The default is set to be 1.
#' @param Imax A positive integer, which stands for the maximum perturbations the algorithm will try without improvements before temperature is reduced. The default is set to be 5. For the computation complexity consideration, \code{Imax} is recommended to be smaller or equal to 5.
#' @param OC An optimality criterion. The default setting is "phi_p", and it could be one of the following: "phi_p", "AvgAbsCor", "MaxAbsCor", "MaxProCriterion".
#' @param p A positive integer, which is the parameter in the phi_p formula, and \code{p} is prefered to be large. The default is set to be 15.
#' @param q The default is set to be 1, and it could be either 1 or 2. If \code{q} is 1, \code{dij} is the Manhattan (rectangular) distance. If \code{q} is 2, \code{dij} is the Euclidean distance.
#' @param maxtime A positive number, which indicates the expected maximum CPU time given by user, and it is measured by minutes. For example, maxtime=3.5 indicates the CPU time will be no greater than three and half minutes. The default is set to be 5.
#'
#' @return If all inputs are logical, then the output will be an LHD whose sizes are the same as input OA. The assumption is that the elements of OAs must be positive.
#'
#' @references Leary, S., Bhaskar, A., and Keane, A. (2003) Optimal orthogonal-array-based latin hypercubes. \emph{Journal of Applied Statistics}, \strong{30}, 585-598.
#'
#' @examples
#' #create an OA(9,2,3,2)
#' OA=matrix(c(rep(1:3,each=3),rep(1:3,times=3)),ncol=2,nrow=9,byrow = FALSE)
#'
#' #Use above "OA" as the input OA to generate a 9 by 2 maximin distance LHD
#' #with the default setting
#' try=OASA(OA=OA)
#' try
#' phi_p(try)   #calculate the phi_p of "try".
#'
#' #Another example
#' #generate a 9 by 2 nearly orthogonal LHD
#' try2=OASA(OA=OA,OC="MaxAbsCor")
#' try2
#' MaxAbsCor(try2)  #calculate the maximum absolute correlation.
#' @export

OASA=function(OA,N=10,T0=10,rate=0.1,Tmin=1,Imax=5,OC="phi_p",p=15,q=1,maxtime=5){
  n=dim(OA)[1]
  m=dim(OA)[2]
  s=length(unique(OA[,1]))

  #OA: OA must be an orthogonal array
  #n: number of rows of OA
  #m: number of columns of OA
  #s: number of levels of OA

  #N: maximum number of iterations.
  #T0: initial temperature
  #rate: temperature decrease rate. 0<rate<1
  #Tmin: minumum temperature for each itertaion,TPmin > 0
  #Imax:# of perturbations the algorithm will try without improvements before Temperature is reduced
  #OC: optimality criterion, the default is "phi_p", along with default p and q

  maxtime=maxtime*60  #convert minutes to seconds
  timeALL=NULL        #record all cpu time

  C=1  #step 1: counter index

  #step 2 begins
  X=OA

  #Create a 3-dimentional array named k, which corresponds to k=1,2,...,s
  k=rep(0,n)
  dim(k)=c(n/s,1,s)

  for (j in 1:m) {
    for (i in 1:s) {
      k[,,i]=seq(from=(i-1)*n/s+1,to=(i-1)*n/s+n/s,1) #This is the formula from Tang (1993)
      k[,,i]=sample(k[,,i])

      X[,j][X[,j]==i]=k[,,i]*100

    }
  }
  X=X/100
  #step 2 ends

  Xbest=X;TP=T0;Flag=1

  if(OC=="phi_p"){

    progressbar = utils::txtProgressBar(min = 0, max = N, style = 3)

    while (C<=N) {

      time0=Sys.time()

      while(Flag==1 & TP>Tmin){
        Flag=0;I=1

        while (I<=Imax) {
          rcol=sample(1:m,1)   #step 3:Randomly choose a column

          #step 4 starts
          rrow=sample(1:n,1)         #Randomly choose a row

          e1=X[rrow,rcol]            #locate the randomly chosen element

          group=ceiling(e1/(n/s))        #locate the e1's level group in the OA

          #randomly select the 2nd element whose OA entry agrees with e1:
          e2=sample(k[,,group][k[,,group]!=e1],1)

          Xnew=X

          Xnew[,rcol][Xnew[,rcol]==e2]=e1

          Xnew[rrow,rcol]=e2
          #step 4 ends


          a=phi_p(X=Xnew,p=p,q=q)       #step 5 begins here
          b=phi_p(X=X,p=p,q=q)
          if (a<b){X=Xnew;Flag=1}
          if (a>=b){
            prob=exp((b-a)/TP)
            draw=sample(c(0,1),1,prob=c(1-prob,prob))    #draw==1 means replace
            if(draw==1){X=Xnew;Flag=1}
          }                         #step 5 ends here

          c=phi_p(X=Xbest,p=p,q=q)
          if (a<c){Xbest=Xnew;I=1}
          if (a>=c){I=I+1}

        }

        TP=TP*(1-rate)
      }

      time1=Sys.time()
      timediff=time1-time0
      timeALL=c(timeALL,timediff)

      ##########progress bar codes
      utils::setTxtProgressBar(progressbar, C)
      ##########

      if(as.numeric(sum(timeALL)+timediff)<=maxtime){C=C+1}
      if(as.numeric(sum(timeALL)+timediff)>maxtime){C=N+1}
      TP=T0;Flag=1
    }
  }

  if(OC=="AvgAbsCor"){

    progressbar = utils::txtProgressBar(min = 0, max = N, style = 3)

    while (C<=N) {

      time0=Sys.time()

      while(Flag==1 & TP>Tmin){
        Flag=0;I=1

        while (I<=Imax) {
          rcol=sample(1:m,1)   #step 3:Randomly choose a column

          #step 4 starts
          rrow=sample(1:n,1)         #Randomly choose a row

          e1=X[rrow,rcol]            #locate the randomly chosen element

          group=ceiling(e1/(n/s))        #locate the e1's level group in the OA

          #randomly select the 2nd element whose OA entry agrees with e1:
          e2=sample(k[,,group][k[,,group]!=e1],1)

          Xnew=X

          Xnew[,rcol][Xnew[,rcol]==e2]=e1

          Xnew[rrow,rcol]=e2
          #step 4 ends


          a=AvgAbsCor(X=Xnew)       #step 5 begins here
          b=AvgAbsCor(X=X)
          if (a<b){X=Xnew;Flag=1}
          if (a>=b){
            prob=exp((b-a)/TP)
            draw=sample(c(0,1),1,prob=c(1-prob,prob))    #draw==1 means replace
            if(draw==1){X=Xnew;Flag=1}
          }                         #step 5 ends here

          c=AvgAbsCor(X=Xbest)
          if (a<c){Xbest=Xnew;I=1}
          if (a>=c){I=I+1}

        }

        TP=TP*(1-rate)
      }

      time1=Sys.time()
      timediff=time1-time0
      timeALL=c(timeALL,timediff)

      ##########progress bar codes
      utils::setTxtProgressBar(progressbar, C)
      ##########

      if(as.numeric(sum(timeALL)+timediff)<=maxtime){C=C+1}
      if(as.numeric(sum(timeALL)+timediff)>maxtime){C=N+1}
      TP=T0;Flag=1
    }
  }

  if(OC=="MaxAbsCor"){

    progressbar = utils::txtProgressBar(min = 0, max = N, style = 3)

    while (C<=N) {

      time0=Sys.time()

      while(Flag==1 & TP>Tmin){
        Flag=0;I=1

        while (I<=Imax) {
          rcol=sample(1:m,1)   #step 3:Randomly choose a column

          #step 4 starts
          rrow=sample(1:n,1)         #Randomly choose a row

          e1=X[rrow,rcol]            #locate the randomly chosen element

          group=ceiling(e1/(n/s))        #locate the e1's level group in the OA

          #randomly select the 2nd element whose OA entry agrees with e1:
          e2=sample(k[,,group][k[,,group]!=e1],1)

          Xnew=X

          Xnew[,rcol][Xnew[,rcol]==e2]=e1

          Xnew[rrow,rcol]=e2
          #step 4 ends


          a=MaxAbsCor(X=Xnew)       #step 5 begins here
          b=MaxAbsCor(X=X)
          if (a<b){X=Xnew;Flag=1}
          if (a>=b){
            prob=exp((b-a)/TP)
            draw=sample(c(0,1),1,prob=c(1-prob,prob))    #draw==1 means replace
            if(draw==1){X=Xnew;Flag=1}
          }                         #step 5 ends here

          c=MaxAbsCor(X=Xbest)
          if (a<c){Xbest=Xnew;I=1}
          if (a>=c){I=I+1}

        }

        TP=TP*(1-rate)
      }

      time1=Sys.time()
      timediff=time1-time0
      timeALL=c(timeALL,timediff)

      ##########progress bar codes
      utils::setTxtProgressBar(progressbar, C)
      ##########

      if(as.numeric(sum(timeALL)+timediff)<=maxtime){C=C+1}
      if(as.numeric(sum(timeALL)+timediff)>maxtime){C=N+1}
      TP=T0;Flag=1
    }
  }

  if(OC=="MaxProCriterion"){

    progressbar = utils::txtProgressBar(min = 0, max = N, style = 3)

    while (C<=N) {

      time0=Sys.time()

      while(Flag==1 & TP>Tmin){
        Flag=0;I=1

        while (I<=Imax) {
          rcol=sample(1:m,1)   #step 3:Randomly choose a column

          #step 4 starts
          rrow=sample(1:n,1)         #Randomly choose a row

          e1=X[rrow,rcol]            #locate the randomly chosen element

          group=ceiling(e1/(n/s))        #locate the e1's level group in the OA

          #randomly select the 2nd element whose OA entry agrees with e1:
          e2=sample(k[,,group][k[,,group]!=e1],1)

          Xnew=X

          Xnew[,rcol][Xnew[,rcol]==e2]=e1

          Xnew[rrow,rcol]=e2
          #step 4 ends


          a=MaxProCriterion(X=Xnew)       #step 5 begins here
          b=MaxProCriterion(X=X)
          if (a<b){X=Xnew;Flag=1}
          if (a>=b){
            prob=exp((b-a)/TP)
            draw=sample(c(0,1),1,prob=c(1-prob,prob))    #draw==1 means replace
            if(draw==1){X=Xnew;Flag=1}
          }                         #step 5 ends here

          c=MaxProCriterion(X=Xbest)
          if (a<c){Xbest=Xnew;I=1}
          if (a>=c){I=I+1}

        }

        TP=TP*(1-rate)
      }

      time1=Sys.time()
      timediff=time1-time0
      timeALL=c(timeALL,timediff)

      ##########progress bar codes
      utils::setTxtProgressBar(progressbar, C)
      ##########

      if(as.numeric(sum(timeALL)+timediff)<=maxtime){C=C+1}
      if(as.numeric(sum(timeALL)+timediff)>maxtime){C=N+1}
      TP=T0;Flag=1
    }
  }

  avgtime=round(mean(timeALL),2)
  iterations=length(timeALL)

  close(progressbar)
  print(paste0("average CPU time per iteration is: ", avgtime, " seconds"))
  print(paste0("the number of iterations completed is: ", iterations))
  print(paste0("the elements in design matrix is scaled to be 1 to ", n))

  Xbest
}