Start/stopping Mosel from Excel and capturing output

Not compatible with version of Mosel < 1.4.0.

This example demonstrates the following

• How to start and stop a mosel model from Excel/VBA
• How to stop the XPRMrunmod call from locking up the Excel interface
• How to capture the Mosel output and print to a worksheet and the Immediate window

The I/O driver functionality is used with XPRMsetdefstream to redirect the Mosel output streams to a VB callback function.

Inside this callback function we do 3 tasks.

1. Print the message to our sheet and the VB editors Immediate window
2. Check to see if our stop flag has been set and stop Mosel if it has
3. Call DoEvents to tell Excel to process its Windows message queue and thus service its GUI interface

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

   file s8els.mos
   ``````````````
   Economic lot sizing, ELS, problem
   (Cut generation algorithm adding (l,S)-inequalities 
    in one or several rounds at the root node or in 
    tree nodes)
       
   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, June 2003, rev. July 2023
  *******************************************************!)

model "S-8 ELS"
 uses "mmxprs","mmsystem"

 parameters
  ALG = 0                              ! Default algorithm: no user cuts
  CUTDEPTH = 10                        ! Maximum tree depth for cut generation
  EPS = 1e-6                           ! Zero tolerance
  FULLPATH = ''
 end-parameters 

 forward function cb_node:boolean
 forward procedure tree_cut_gen

 declarations
  TIMES = 1..20                             ! Range of time
  PRODUCTS = 1..4                           ! Set of products

  DEMAND: array(PRODUCTS,TIMES) of integer  ! Demand per period
  SETUPCOST: array(TIMES) of integer        ! Setup cost per period
  PRODCOST: array(PRODUCTS,TIMES) of real   ! Production cost per period
  CAP: array(TIMES) of integer              ! Production capacity per period
  D: array(PRODUCTS,TIMES,TIMES) of integer ! Total demand in periods t1 - t2

  produce: array(PRODUCTS,TIMES) of mpvar   ! Production in period t
  setup: array(PRODUCTS,TIMES) of mpvar     ! Setup in period t

  solprod: array(PRODUCTS,TIMES) of real    ! Sol. values for var.s produce 
  solsetup: array(PRODUCTS,TIMES) of real   ! Sol. values for var.s setup
  starttime: real
 end-declarations

 initializations from FULLPATH + "s8els.dat"
  DEMAND SETUPCOST PRODCOST CAP
 end-initializations

 forall(p in PRODUCTS,s,t in TIMES) D(p,s,t):= sum(k in s..t) DEMAND(p,k)

! Objective: minimize total cost
 MinCost:= sum(t in TIMES) (SETUPCOST(t) * sum(p in PRODUCTS) setup(p,t) + 
                            sum(p in PRODUCTS) PRODCOST(p,t) * produce(p,t) )

! Satisfy the total demand
 forall(p in PRODUCTS,t in TIMES) 
   sum(s in 1..t) produce(p,s) >= sum (s in 1..t) DEMAND(p,s)

! If there is production during t then there is a setup in t
 forall(p in PRODUCTS, t in TIMES) 
  produce(p,t) <= D(p,t,getlast(TIMES)) * setup(p,t)

! Capacity limits
 forall(t in TIMES) sum(p in PRODUCTS) produce(p,t) <= CAP(t)

! Variables setup are 0/1
 forall(p in PRODUCTS, t in TIMES) setup(p,t) is_binary 

! Uncomment to get detailed MIP output
 setparam("XPRS_VERBOSE", true)

 writeln("**************ALG=",ALG,"***************")

 SEVERALROUNDS:=false; TOPONLY:=false

 case ALG of
  1: setparam("XPRS_CUTSTRATEGY", 0)  ! No cuts
  2: setparam("XPRS_PRESOLVE", 0)     ! No presolve
  3: tree_cut_gen                     ! User branch-and-cut + automatic cuts
  4: do                               ! User branch-and-cut (several rounds),
      tree_cut_gen                    ! no automatic cuts
      setparam("XPRS_CUTSTRATEGY", 0)
      SEVERALROUNDS:=true
     end-do
  5: do                               ! User cut-and-branch (several rounds)
      tree_cut_gen                    ! + automatic cuts
      SEVERALROUNDS:=true
      TOPONLY:=true
     end-do
  6: do                               ! User branch-and-cut (several rounds)
      tree_cut_gen                    ! + automatic cuts
      SEVERALROUNDS:=true
     end-do
 end-case

 setparam("xprs_threads",1)           ! Disable parallel to prevent Excel freezing up when processing optimizer log lines
 setparam("XPRS_MIPLOG",-20)
 minimize(MinCost)                    ! Solve the problem
                                       
 writeln("Time: ", 44, "sec,  Nodes: ", getparam("XPRS_NODES"),
         ",  Solution: ", getobjval) 
 write("Period  setup    ")
 forall(p in PRODUCTS) write(strfmt(p,-7))
 forall(t in TIMES) do
  write("\n ", strfmt(t,2), strfmt(getsol(sum(p in PRODUCTS) setup(p,t)),8), "     ")
  forall(p in PRODUCTS) write(getsol(produce(p,t)), " (",DEMAND(p,t),")  ")
 end-do
 writeln

!*************************************************************************
!  Cut generation loop:                         
!    get the solution values                                            
!    identify and set up violated constraints                           
!    load the modified problem and load the saved basis                 
!*************************************************************************

 function cb_node:boolean
  declarations
   ncut:integer                        ! Counter for cuts
   cut: array(range) of linctr         ! Cuts
   cutid: array(range) of integer      ! Cut type identification
   type: array(range) of integer       ! Cut constraint type 
   objval,ds: real
  end-declarations

  returned:=false                     ! OPTNODE: This node is not infeasible

  depth:=getparam("XPRS_NODEDEPTH")
  cnt:=getparam("XPRS_CALLBACKCOUNT_OPTNODE")

  if ((TOPONLY and depth<1) or (not TOPONLY and depth<=CUTDEPTH)) and 
     (SEVERALROUNDS or cnt<=1) then
   ncut:=0 

 ! Get the solution values
   forall(t in TIMES, p in PRODUCTS) do
     solprod(p,t):=getsol(produce(p,t))
     solsetup(p,t):=getsol(setup(p,t))
   end-do
  
 ! Search for violated constraints
   forall(p in PRODUCTS,l in TIMES) do
    ds:=0 
    forall(t in 1..l)
      if (solprod(p,t) < D(p,t,l)*solsetup(p,t) + EPS) then ds += solprod(p,t)
      else  ds += D(p,t,l)*solsetup(p,t)
      end-if
  
   ! Generate the violated inequality    
    if (ds < D(p,1,l) - EPS) then
      cut(ncut):= sum(t in 1..l) 
       if(solprod(p,t)<(D(p,t,l)*solsetup(p,t))+EPS, produce(p,t), 
          D(p,t,l)*setup(p,t)) - D(p,1,l)
      cutid(ncut):= 1
      type(ncut):= CT_GEQ
      ncut+=1
    end-if   
  end-do
   
 ! Add cuts to the problem
   if ncut>0 then 
    addcuts(cutid, type, cut);  
    writeln("Cuts added : ", ncut, " (depth ", depth, ", node ", 
            getparam("XPRS_NODES"), ", obj. ", getparam("XPRS_LPOBJVAL"), ")")
   end-if
  end-if
 end-function

! ****Optimizer settings for using the cut manager****

 procedure tree_cut_gen
  setparam("XPRS_PRESOLVE", 0)        ! Switch presolve off
  setparam("XPRS_EXTRAROWS", 5000)    ! Reserve extra rows in matrix
  setcallback(XPRS_CB_OPTNODE, ->cb_node)  ! Set the optnode callback func.
 end-procedure

end-model