R/ParetoR_2C_1AIR.R

Defines functions myTCon_eq_2C_1AIR myT_2C_1AIR myLinCom_2C_1AIR Weight_Generate_2C_1AIR WeightsFun_2C_1AIR dimFun_2C_1AIR assert_col_vec_2C_1AIR myCon_eq_2C_1AIR myCon_ineq_2C_1AIR myFM_2C_1AIR combR_2C_1AIR NBI_2C_1AIR ParetoR_2C_1AIR

Documented in assert_col_vec_2C_1AIR combR_2C_1AIR dimFun_2C_1AIR myCon_eq_2C_1AIR myCon_ineq_2C_1AIR myFM_2C_1AIR myLinCom_2C_1AIR myT_2C_1AIR myTCon_eq_2C_1AIR NBI_2C_1AIR ParetoR_2C_1AIR Weight_Generate_2C_1AIR WeightsFun_2C_1AIR

# Command Function ParetoR_2C_1AIR: Optimize 2 criteria (continuous) and AI ratio of 1 minority group
## Developer: Q. Chelsea Song
## Contact: qianqisong@gmail.com

#' ParetoR_2C_1AIR
#'
#' Command function to optimize 2 non-adverse impact objectives and 1 adverse
#' impact objective via NBI algorithm
#' @param Rx  Matrix with intercorrelations among predictors
#' @param Rxy1  Vector with correlation between each predictor and non-adverse
#'   impact objective 1
#' @param Rxy2  Vector with correlation between each predictor and non-adverse
#'   impact objective 2
#' @param prop1 Proportion of minority applicants in full applicant pool
#' @param sr Selection ratio in full applicant pool
#' @param d1 Subgroup difference; standardized mean differences between minority
#'   and majority subgroups on each predictor in full applicant pool
#' @param Spac  Number of Pareto points
#' @return out Pareto-Optimal solution with objective outcome values (Criterion)
#'   and predictor weights (ParetoWeights)
#' @export

ParetoR_2C_1AIR = function(Rx, Rxy1, Rxy2, sr, prop1, d1, Spac = 10){

  # Rx_2C_1AIR <<- Rx
  # Rxy1_2C_1AIR <<- Rxy1
  # Rxy2_2C_1AIR <<- Rxy2
  # sr_2C_1AIR <<- sr
  # prop1_2C_1AIR <<- prop1
  # d1_2C_1AIR <<- d1
  assign("Rx_2C_1AIR", Rx, rMOSTenv_2C_1AIR)
  assign("Rxy1_2C_1AIR", Rxy1, rMOSTenv_2C_1AIR)
  assign("Rxy2_2C_1AIR", Rxy2, rMOSTenv_2C_1AIR)
  assign("sr_2C_1AIR", sr, rMOSTenv_2C_1AIR)
  assign("prop1_2C_1AIR", prop1, rMOSTenv_2C_1AIR)
  assign("d1_2C_1AIR", d1, rMOSTenv_2C_1AIR)

  # Tolerance Level for Algorithm
  TolCon 	= 1e-7 # tolerance of constraint
  TolF 	= 1e-15 # tolerance of objective function
  TolX 	= 1e-15 # tolerance of predictor variable

  # Do not change
  Fnum 	= 3
  Xnum = dim(Rx)[1]
  VLB = c(-(Xnum+1),rep(0,Xnum))
  VUB = c((Xnum+1),rep(1,Xnum))
  X0 = c(1,rep(1/Xnum,Xnum))

  ###### Find Pareto-Optimal Solution ######

  out = suppressWarnings(NBI_2C_1AIR(X0, Spac, Fnum, VLB, VUB, TolX, TolF, TolCon))
  return(out)

}





####################################### NBI Main Function ####################################

#' NBI Main Function
#'
#' Main function for obtaining pareto-optimal solution via normal boundary intersection.
#' @param X0 Initial input for predictor weight vector
#' @param Spac Number of Pareto spaces (i.e., number of Pareto points minus one)
#' @param Fnum Number of criterions
#' @param VLB Lower boundary for weight vector estimation
#' @param VUB Upper boundary for weight vector estimation
#' @param TolX Tolerance index for estimating weight vector, default is 1e-4
#' @param TolF Tolerance index for estimating criterion, default is 1e-4
#' @param TolCon Tolerance index for constraint conditions, default is 1e-7
#' @import nloptr
#' @return Pareto-Optimal solutions
#' @keywords internal

NBI_2C_1AIR = function(X0,Spac,Fnum,VLB=vector(),VUB=vector(),TolX=1e-4,TolF=1e-4,TolCon=1e-7){

  # cat('\n Estimating Pareto-Optimal Solution ... \n')

  #------------------------------Initialize Options-------------------------------#

  X0 = assert_col_vec_2C_1AIR(X0)
  VLB = assert_col_vec_2C_1AIR(VLB)
  VUB = assert_col_vec_2C_1AIR(VUB)

  # Number of variables
  nvars = length(X0)

  # Set options
  # algorithm: sequential (least-squares) quadratic programming algorithm
  # (SQP is algorithm for nonlinearly constrained, gradient-based optimization,
  # supporting both equality and inequality constraints.)
  # maxeval: Max Iterations
  # xtol_abs: Tolerance for X
  # ftol_abs: Tolerance for F
  # tol_constraints_ineq/eq: Tolerance for inequal/equal constraints
  # (for reference) MATLAB constraints:
  # options = optimoptions('fmincon','Algorithm','sqp','MaxIter',(nvars+1)*1000,'TolFun',TolF,'TolX',TolX,'TolCon',TolCon,'Display','off')

  suppressMessages(nloptr::nl.opts(optlist = list(
    maxeval = (nvars+1)*1000
    ,xtol_rel = TolX
    ,ftol_rel = TolF
  )))

  #Initialize PHI

  PHI = matrix(0,Fnum,Fnum)

  #------------------------------Shadow Point-------------------------------#

  # cat('\n ----Step 1: find shadow minimum---- \n')

  ShadowF = matrix(0,Fnum)
  ShadowX = matrix(0,nvars,Fnum)
  xstart  = X0
  out = WeightsFun_2C_1AIR(Fnum,Spac)
  Weight = out$Weights
  Near = out$Formers
  rm(out)
  Weight = Weight/Spac

  for(i in 1:Fnum){

    temp = c(1,(Spac+1),dim(Weight)[2])
    j = temp[i]
    # g_Weight_2C_1AIR <<- Weight[,j]
    assign("g_Weight_2C_1AIR", Weight[,j], rMOSTenv_2C_1AIR)

    out = suppressMessages(nloptr::slsqp(x0 = X0, fn = myLinCom_2C_1AIR
                                         ,lower = VLB, upper = VUB
                                         ,hin = myCon_ineq_2C_1AIR
                                         ,heq = myCon_eq_2C_1AIR,
                                         control = list("maxeval" = (nvars+1)*1000,
                                                        "xtol_rel" = TolX,
                                                        "ftol_rel" = TolF)
    ))

    x = out$par

    x[1:nvars] = x[1:nvars]/sum(x[1:nvars])
    x[2:nvars] = x[2:nvars]/sum(x[2:nvars])

    ShadowX[,i] = x

    tempF = myFM_2C_1AIR(x)
    ShadowF[i] = tempF[i]

  }


  #------------------------------Matrix PHI-------------------------------#

  # cat('\n ----Step 2: find PHI---- \n')

  for(i in 1:Fnum){

    PHI[,i] = myFM_2C_1AIR(ShadowX[,i]) + ShadowF
    PHI[i,i] = 0

  }

  # print(round(PHI,3))

  assign("ShadowF_2C_1AIR", ShadowF, rMOSTenv_2C_1AIR)
  assign("PHI_2C_1AIR", PHI, rMOSTenv_2C_1AIR)

  #Check to make sure that QPP is n-1 dimensional
  # if(rcond(PHI_2C_1AIR) < 1e-8){stop(' Phi matrix singular, aborting.')}
  if(rcond(rMOSTenv_2C_1AIR$PHI_2C_1AIR) < 1e-8){stop(' Phi matrix singular, aborting.')}

  #------------------------------Quasi-Normal Direction-------------------------------#

  # cat('\n ----Step 3: find Quasi-Normal---- \n')

  # g_Normal_2C_1AIR <<- -PHI_2C_1AIR%*%matrix(1,Fnum,1)
  # assign("g_Normal_2C_1AIR", -PHI_2C_1AIR%*%matrix(1,Fnum,1), rMOSTenv_2C_1AIR)
  assign("g_Normal_2C_1AIR", -rMOSTenv_2C_1AIR$PHI_2C_1AIR%*%matrix(1,Fnum,1), rMOSTenv_2C_1AIR)

  #------------------------------weights-------------------------------#

  # cat('\n ----Step 4: create weights---- \n')

  out = WeightsFun_2C_1AIR(Fnum,Spac)
  Weight = out$Weight
  Near = out$Formers
  Weight = Weight/Spac
  num_w = dimFun_2C_1AIR(Weight)[2]

  # cat('\n Weights in row: \n')
  # print(round(Weight,3))

  #------------------------------NBI Subproblems-------------------------------#

  # cat('\n ----Step 5: solve NBI sub-problems---- \n')

  # Starting point for first NBI subproblem is the minimizer of f_1(x)
  xstart = c(ShadowX[,1],0)

  Pareto_Fmat = vector()       # Pareto Optima in F-space
  Pareto_Xmat = vector()       # Pareto Optima in X-space
  X_Near      = vector()

  # solve NBI subproblems
  for(k in 1:num_w){

    w  = Weight[,k]

    # Solve problem only if it is not minimizing one of the individual objectives
    indiv_fn_index = which(w == 1)
    # the boundary solution which has been solved

    if(length(indiv_fn_index) != 0){

      # w has a 1 in indiv_fn_index th component, zero in rest
      # Just read in solution from shadow data
      # Pareto_Fmat = cbind(Pareto_Fmat, (-PHI_2C_1AIR[,indiv_fn_index] + ShadowF_2C_1AIR))
      Pareto_Fmat = cbind(Pareto_Fmat, (-rMOSTenv_2C_1AIR$PHI_2C_1AIR[,indiv_fn_index] + rMOSTenv_2C_1AIR$ShadowF_2C_1AIR))
      Pareto_Xmat = cbind(Pareto_Xmat, ShadowX[,indiv_fn_index])
      X_Near = cbind(X_Near, c(ShadowX[,indiv_fn_index],0))
      # print(Pareto_Fmat)

    }else{

      w = rev(w)

      if(Near[k] > 0){

        xstart = X_Near[,Near[k]]
        #start X is the previous weight-order's X

      }

      #start point in F-space
      # g_StartF_2C_1AIR <<- PHI_2C_1AIR%*%w + ShadowF_2C_1AIR
      assign("g_StartF_2C_1AIR", rMOSTenv_2C_1AIR$PHI_2C_1AIR%*%w + rMOSTenv_2C_1AIR$ShadowF_2C_1AIR, rMOSTenv_2C_1AIR)

      # SOLVE NBI SUBPROBLEM

      out = suppressMessages(nloptr::slsqp(x0 = xstart, fn = myT_2C_1AIR
                                           ,lower = c(VLB,-Inf)
                                           ,upper = c(VUB,Inf)
                                           ,hin = myCon_ineq_2C_1AIR
                                           ,heq = myTCon_eq_2C_1AIR))

      x_trial = out$par
      f = out$value
      rm(out)

      # success
      # if(fiasco >= 0){

      Pareto_Fmat = cbind(Pareto_Fmat, -myFM_2C_1AIR(x_trial[1:nvars]))  # Pareto optima in F-space
      som = 0

      for(k in 2:nvars){som = som + x_trial[k]}

      for(k in 2:nvars){x_trial[k] = x_trial[k]/som}

      Pareto_Xmat = cbind(Pareto_Xmat, x_trial[1:nvars])        # Pareto optima in X-space
      X_Near = cbind(X_Near,x_trial)

    }

  }

  #------------------------------Plot Solutions-------------------------------#

  #   cat('\n ----Step 6: plot---- \n')

  # if(graph==TRUE){plotPareto_2C_1AIR(Pareto_Fmat, Pareto_Xmat)}

  #------------------------------Output Solutions-------------------------------#

  #   Output Solution

  Pareto_Fmat = t(Pareto_Fmat)
  Pareto_Xmat = t(Pareto_Xmat[2:nrow(Pareto_Xmat),])
  colnames(Pareto_Fmat) = c("AIR","Ry1","Ry2")
  colnames(Pareto_Xmat) = c(paste0(rep("P",(nvars-1)),1:(nvars-1)))

  # if(display_solution == TRUE){
  #
  #   solution = round(cbind(Pareto_Fmat,Pareto_Xmat),3)
  #   colnames(solution) = c("AIR","Ry1","Ry2", paste0(rep("P",(nvars-1)),1:(nvars-1)))
  #   cat("\n Pareto-Optimal Solution \n \n")
  #   print(solution)
  #
  # }else{
  # cat("\n Done. \n \n")
  # }


  return(list(Pareto_Fmat = round(Pareto_Fmat, 3),
              Pareto_Xmat = round(Pareto_Xmat, 3)))

}

########################### Supporting Functions (A) ########################

###### combR_2C_1AIR()######

#' combR_2C_1AIR
#'
#' Support function to create predictor-criterion matrix
#' @param Rx Predictor inter-correlation matrix
#' @param Ry Predictor-criterion correlation (validity)
#' @return Rxy Predictor-criterion correlation matrix
#' @keywords internal

combR_2C_1AIR <- function(Rx, Ry){
  cbind(rbind(Rx,c(Ry)),c(Ry,1))
}

###### myFM_2C_1AIR() ######

#' myFM_2C_1AIR
#'
#' Supporting function, defines criterion space
#' @param x Input predictor weight vector
#' @importFrom stats pnorm qnorm runif
#' @return f Criterion vector
#' @keywords internal

myFM_2C_1AIR = function(x){

  d <- rMOSTenv_2C_1AIR$d1_2C_1AIR
  Rx <- rMOSTenv_2C_1AIR$Rx_2C_1AIR
  Rxy1 <- rMOSTenv_2C_1AIR$Rxy1_2C_1AIR
  Rxy2 <- rMOSTenv_2C_1AIR$Rxy2_2C_1AIR

  b = x[-1]

  # variance of minority and majority applicant weighted predictor
  # composite (P) distribution (DeCorte, 1999)
  sigma_p = sqrt(t(b)%*%Rx%*%b)

  # mean of minority weighted predictor composite distribution (DeCorte, 1999)
  p_i_bar = 0
  # mean of majority weighted predictor composite distribution (DeCorte, 1999)
  p_a_bar = d%*%x[-1]/sigma_p
  # minority group selection ratio (denoted as h_i in DeCorte et al., 1999)
  SR_min = 1 - pnorm(x[1], p_i_bar)
  # majority group selection ratio (denoted as h_i in DeCorte et al., 1999)
  SR_maj = 1 - pnorm(x[1], p_a_bar)

  # AIratio a_g (DeCorte et al., 2007)
  a_g = SR_min/SR_maj

  # Composite Validity R_xy

  R_cy1 = t(c(t(b),0)%*%combR_2C_1AIR(Rx,Rxy1)%*%c(t(matrix(0,dimFun_2C_1AIR(Rx)[1],1)),1))/sqrt(t(b)%*%Rx%*%b) # DeCorte et al., 2007
  R_cy2 = t(c(t(b),0)%*%combR_2C_1AIR(Rx,Rxy2)%*%c(t(matrix(0,dimFun_2C_1AIR(Rx)[1],1)),1))/sqrt(t(b)%*%Rx%*%b) # DeCorte et al., 2007

  f = matrix(1,3,1)
  f[1,] = -a_g
  f[2,] = -R_cy1
  f[3,] = -R_cy2

  return(f)

}

####### myCon_ineq_2C_1AIR() ######

# Nonlinear inequalities at x

#' myCon_ineq_2C_1AIR
#'
#' Support function, defines inequal constraint condition
#' @param x Input predictor weight vector
#' @return Inequal constraint condition for use in NBI()
#' @keywords internal

myCon_ineq_2C_1AIR = function(x){return(vector())}

####### myCon_eq_2C_1AIR() ######

# Nonlinear equalities at x

#' myCon_eq_2C_1AIR
#'
#' Support function, defines equal constraint condition
#' @param x Input predictor weight vector
#' @importFrom stats pnorm
#' @return Equal constraint condition for use in NBI()
#' @keywords internal

myCon_eq_2C_1AIR = function(x){

  # Obtain within-package 'global' variable from package env
  # prop <- prop1_2C_1AIR
  # sr <- sr_2C_1AIR
  # d <- d1_2C_1AIR
  # Rx <- Rx_2C_1AIR
  prop <- rMOSTenv_2C_1AIR$prop1_2C_1AIR
  sr <- rMOSTenv_2C_1AIR$sr_2C_1AIR
  d <- rMOSTenv_2C_1AIR$d1_2C_1AIR
  Rx <- rMOSTenv_2C_1AIR$Rx_2C_1AIR

  b = x[-1]

  # variance of minority and majority applicant weighted predictor
  # composite (P) distribution (DeCorte, 1999)
  sigma_p = sqrt(t(b)%*%Rx%*%b)

  # mean of minority weighted predictor composite distribution (DeCorte, 1999)
  p_i_bar = 0
  # mean of majority weighted predictor composite distribution (DeCorte, 1999)
  p_a_bar = d%*%x[-1]/sigma_p
  # p_a_bar = (x[2]*1.00+x[3]*0.23+x[4]*0.09+x[5]*0.33)/sigma_p
  # minority group selection ratio (denoted as h_i in DeCorte et al., 1999)
  SR_min = 1 - pnorm(x[1], p_i_bar)
  # majority group selection ratio (denoted as h_i in DeCorte et al., 1999)
  SR_maj = 1 - pnorm(x[1], p_a_bar)

  # Nonlinear equalities at x

  ceq = matrix(1,2,1)
  ceq[1,] = SR_min*prop + SR_maj*(1-prop) - sr # DeCorte et al. (2007)
  ceq[2,] = (t(b)%*%Rx%*%b) - 1

  return(ceq)

}

########################### Supporting Functions (B) ########################

# Supplementary Functions for NBI.r - Pareto-Optimization via Normal Boundary Intersection

# Function List
## assert_col_vec_2C_1AIR
## dimFun_2C_1AIR
## WeightsFun_2C_1AIR
## Weight_Generate_2C_1AIR
## myLinCom_2C_1AIR
## myT_2C_1AIR
## myTCon_eq_2C_1AIR
## plotPareto_2C_1AIR

###### assert_col_vec_2C_1AIR() ######

#' assert_col_vec_2C_1AIR
#'
#' Support function, refines intermediate variable for use in NBI()
#' @param v Intermediate variable v
#' @return Refined variable v
#' @keywords internal

assert_col_vec_2C_1AIR = function(v){
  if(is.null(dimFun_2C_1AIR(v))){
    v=v
  }else if(dimFun_2C_1AIR(v)[1] < dimFun_2C_1AIR(v)[2]){v = t(t)}
  return(v)}

###### dimFun_2C_1AIR() ######

#' dimFun_2C_1AIR
#'
#' Support function, checks input predictor weight vector x
#' @param x Input predictor weight vector
#' @return x Checked and refined input predictor weight vector
#' @keywords internal

dimFun_2C_1AIR = function(x){
  if(is.null(dim(x))){
    return(c(0,0))
  }else(return(dim(x)))
}

###### WeightsFun_2C_1AIR() ######

#' WeightsFun_2C_1AIR
#'
#' Support function, generates all possible weights for NBI subproblems
#' @param n Number of objects (i.e., number of predictor and criterion)
#' @param k Number of Pareto points
#' @return Weights All possible weights for NBI subproblem
#' @keywords internal

WeightsFun_2C_1AIR = function(n, k){

  # package env variables
  # weight, Weights, Formers, Layer, lastone, currentone
  #
  # Generates all possible weights for NBI subproblems given:
  # n, the number of objectives
  # 1/k, the uniform spacing between two w_i (k integral)
  # This is essentially all the possible integral partitions
  # of integer k into n parts.

  assign("WeightSub_2C_1AIR", matrix(0,1,n), rMOSTenv_2C_1AIR)
  # WeightSub <<- matrix(0,1,n)
  assign("Weights_2C_1AIR", vector(), rMOSTenv_2C_1AIR)
  # Weights <<- vector()
  assign("Formers_2C_1AIR", vector(), rMOSTenv_2C_1AIR)
  # Formers <<- vector()
  assign("Layer_2C_1AIR", n, rMOSTenv_2C_1AIR)
  # Layer <<- n
  assign("lastone_2C_1AIR", -1, rMOSTenv_2C_1AIR)
  # lastone <<- -1
  assign("currentone_2C_1AIR", -1, rMOSTenv_2C_1AIR)
  # currentone <<- -1

  Weight_Generate_2C_1AIR(1, k)

  return(list(Weights = rMOSTenv_2C_1AIR$Weights_2C_1AIR, Formers = rMOSTenv_2C_1AIR$Formers_2C_1AIR))

}

###### Weight_Generate_2C_1AIR() ######

#' Weight_Generate_2C_1AIR
#'
#' Function intended to test the weight generation scheme for NBI for > 2 objectives
#' @param n Number of objects (i.e., number of predictor and criterion)
#' @param k Number of Pareto points
#' @return Weight_Generate_2C_1AIR
#' @keywords internal

Weight_Generate_2C_1AIR = function(n, k){

  # package env variables:
  # weight Weights Formers Layer lastone currentone

  # wtgener_test(n,k)
  #
  # Intended to test the weight generation scheme for NBI for > 2 objectives
  # n is the number of objectives
  # 1/k is the uniform spacing between two w_i (k integral)

  # if(n == Layer){
  #
  #   if(currentone >= 0){
  #     Formers <<- c(Formers,lastone)
  #     lastone <<- currentone
  #     currentone <<- -1
  #   }else{
  #     num = dimFun_2C_1AIR(Weights)[2]
  #     Formers <<- c(Formers,num)
  #   }
  #
  #   WeightSub[(Layer - n + 1)] <<- k
  #   Weights <<- cbind(Weights,t(WeightSub))
  #
  # }else{
  #
  #   for(i in 0:k){
  #     if(n == (Layer - 2)){
  #       num = dimFun_2C_1AIR(Weights)[2]
  #       currentone <<- num+1
  #     }
  #
  #     WeightSub[(Layer - n + 1)] <<- i
  #     Weight_Generate_2C_1AIR(n+1, k-i)
  #   }
  #
  # }

  if(n == rMOSTenv_2C_1AIR$Layer_2C_1AIR){

    if(rMOSTenv_2C_1AIR$currentone_2C_1AIR >= 0){
      rMOSTenv_2C_1AIR$Formers_2C_1AIR <- c(rMOSTenv_2C_1AIR$Formers_2C_1AIR,rMOSTenv_2C_1AIR$lastone_2C_1AIR)
      rMOSTenv_2C_1AIR$lastone_2C_1AIR <- rMOSTenv_2C_1AIR$currentone_2C_1AIR
      rMOSTenv_2C_1AIR$currentone_2C_1AIR <- -1

    }else{
      num = dimFun_2C_1AIR(rMOSTenv_2C_1AIR$Weights_2C_1AIR)[2]
      rMOSTenv_2C_1AIR$Formers_2C_1AIR <- c(rMOSTenv_2C_1AIR$Formers_2C_1AIR,num)
    }

    rMOSTenv_2C_1AIR$WeightSub_2C_1AIR[(rMOSTenv_2C_1AIR$Layer_2C_1AIR - n + 1)] <- k
    rMOSTenv_2C_1AIR$Weights_2C_1AIR <- cbind(rMOSTenv_2C_1AIR$Weights_2C_1AIR,t(rMOSTenv_2C_1AIR$WeightSub_2C_1AIR))

  }else{

    for(i in 0:k){
      if(n == (rMOSTenv_2C_1AIR$Layer_2C_1AIR - 2)){
        num = dimFun_2C_1AIR(rMOSTenv_2C_1AIR$Weights_2C_1AIR)[2]
        rMOSTenv_2C_1AIR$currentone_2C_1AIR <- num+1
      }

      rMOSTenv_2C_1AIR$WeightSub_2C_1AIR[(rMOSTenv_2C_1AIR$Layer_2C_1AIR - n + 1)] <- i
      Weight_Generate_2C_1AIR(n+1, k-i)
    }

  }

}

###### myLinCom_2C_1AIR() ######

#' myLinCom_2C_1AIR
#'
#' Support function
#' @param x Input predictor weight vector
#' @return f Criterion vector
#' @keywords internal

myLinCom_2C_1AIR = function(x){

  # package env variable: g_Weight_2C_1AIR
  F = myFM_2C_1AIR(x)
  f = t(rMOSTenv_2C_1AIR$g_Weight_2C_1AIR)%*%F

  return(f)

}

###### myT_2C_1AIR() ######

#' myT_2C_1AIR
#'
#' Support function, define criterion space for intermediate step in NBI()
#' @param x_t Temporary input weight vector
#' @return f Temporary criterion space
#' @keywords internal

myT_2C_1AIR = function(x_t){

  f = x_t[length(x_t)]
  return(f)

}

###### myTCon_eq_2C_1AIR() ######

#' myTCon_eq_2C_1AIR
#'
#' Support function, define constraint condition for intermediate step in NBI()
#' @param x_t Temporary input weight vector
#' @return ceq Temporary constraint condition
#' @keywords internal

myTCon_eq_2C_1AIR = function(x_t){

  # package env variables:
  # g_Normal_2C_1AIR g_StartF_2C_1AIR

  t = x_t[length(x_t)]
  x = x_t[1:(length(x_t)-1)]

  fe  = -myFM_2C_1AIR(x) - rMOSTenv_2C_1AIR$g_StartF_2C_1AIR - t * rMOSTenv_2C_1AIR$g_Normal_2C_1AIR

  ceq1 = myCon_eq_2C_1AIR(x)
  ceq = c(ceq1,fe)

  return(ceq)

}

Try the rMOST package in your browser

Any scripts or data that you put into this service are public.

rMOST documentation built on Nov. 9, 2023, 1:08 a.m.