(!******************************************************
   Mosel Example Problems
   ======================

   file folioheur.mos
   ``````````````````
   Modeling a small MIP problem 
   to perform portfolio optimization.
   -- Heuristic solution --
   
  (c) 2008 Fair Isaac Corporation
      author: S.Heipcke, Aug. 2003, rev. Apr. 2021
*******************************************************!)

model "Portfolio optimization solved heuristically"
 uses "mmxprs"

 parameters
  MAXRISK = 1/3                     ! Max. investment into high-risk values
  MAXVAL = 0.3                      ! Max. investment per share
  MINAM = 0.5                       ! Min. investment into N.-American values
  MAXNUM = 4                        ! Max. number of assets
 end-parameters

 forward procedure solve_heur       ! Binary variable fixing heuristic

 declarations
  SHARES: set of string             ! Set of shares
  RISK: set of string               ! Set of high-risk values among shares
  NA: set of string                 ! Set of shares issued in N.-America
  RET: array(SHARES) of real        ! Estimated return in investment
 end-declarations

 initializations from "folio.dat"
  RISK RET NA
 end-initializations

 declarations
  frac: array(SHARES) of mpvar      ! Fraction of capital used per share
  buy: array(SHARES) of mpvar       ! 1 if asset is in portfolio, 0 otherwise
 end-declarations

! Objective: total return
 Return:= sum(s in SHARES) RET(s)*frac(s) 

! Limit the percentage of high-risk values
 sum(s in RISK) frac(s) <= MAXRISK

! Minimum amount of North-American values
 sum(s in NA) frac(s) >= MINAM

! Spend all the capital
 sum(s in SHARES) frac(s) = 1
 
! Upper bounds on the investment per share
 forall(s in SHARES) frac(s) <= MAXVAL

! Limit the total number of assets
 sum(s in SHARES) buy(s) <= MAXNUM

 forall(s in SHARES) do
  buy(s) is_binary
  frac(s) <= buy(s)
 end-do

! Solve problem heuristically
 solve_heur

! Solve the problem
 maximize(Return)

! Solution printing
 if getprobstat=XPRS_OPT then
  writeln("Exact solution: Total return: ", getobjval)
  forall(s in SHARES) writeln(s, ": ", getsol(frac(s))*100, "%")  
 else
  writeln("Heuristic solution is optimal.")
 end-if

!-----------------------------------------------------------------

 procedure solve_heur
  declarations
   TOL: real                       ! Solution feasibility tolerance
   fsol: array(SHARES) of real     ! Solution values for `frac' variables
   bas: basis                      ! LP basis
  end-declarations

  setparam("XPRS_VERBOSE",true)    ! Enable message printing in mmxprs
  setparam("XPRS_CUTSTRATEGY",0)   ! Disable automatic cuts (optional)
  setparam("XPRS_HEUREMPHASIS",0)  ! Disable MIP heuristics (optional)
  setparam("XPRS_PRESOLVE",0)      ! Switch off presolve (required)
  TOL:=getparam("XPRS_FEASTOL")    ! Get feasibility tolerance
  setparam("ZEROTOL",TOL)          ! Set comparison tolerance
  
  maximize(XPRS_LPSTOP,Return)     ! Solve the LP problem
  savebasis(bas)                   ! Save the current basis

 ! Fix all variables `buy' for which `frac' is at 0 or at a relatively
 ! large value
  forall(s in SHARES) do
   fsol(s):= getsol(frac(s))
   if (fsol(s) = 0) then 
    setub(buy(s), 0)
   elif (fsol(s) >= 0.2) then
    setlb(buy(s), 1)
   end-if
  end-do 

  maximize(XPRS_CONT,Return)       ! Solve the MIP problem
  ifgsol:=false
  if getprobstat=XPRS_OPT then     ! If an integer feas. solution was found
   ifgsol:=true
   solval:=getobjval               ! Get the value of the best solution
   writeln("Heuristic solution: Total return: ", solval)
   forall(s in SHARES) writeln(s, ": ", getsol(frac(s))*100, "%")
  end-if

 ! Reset variables to their original bounds
  forall(s in SHARES)
   if ((fsol(s) = 0) or (fsol(s) >= 0.2)) then
    setlb(buy(s), 0)
    setub(buy(s), 1)
   end-if

  loadbasis(bas)                   ! Load the saved basis: bound changes are
                                   ! immediately passed on to the optimizer
                                   ! if the problem has not been modified
                                   ! in any other way, so that there is no
                                   ! need to reload the matrix
  if ifgsol then                   ! Set cutoff to the best known solution
   setparam("XPRS_MIPABSCUTOFF", solval+TOL)
  end-if

 end-procedure
 
end-model