Attribute VB_Name = "glpk"
Option Explicit

' enable/disable flag:
Public Const GLP_ON = 1              ' enable something
Public Const GLP_OFF = 0             ' disable something

' reason codes:
Public Const GLP_IROWGEN = &H1       ' request for row generation
Public Const GLP_IBINGO = &H2        ' better long solution found
Public Const GLP_IHEUR = &H3         ' request for heuristic solution
Public Const GLP_ICUTGEN = &H4       ' request for cut generation
Public Const GLP_IBRANCH = &H5       ' request for branching
Public Const GLP_ISELECT = &H6       ' request for subproblem selection
Public Const GLP_IPREPRO = &H7       ' request for preprocessing

' optimization direction flag:
Public Const GLP_MIN = 1             ' minimization
Public Const GLP_MAX = 2             ' maximization

' kind of structural variable:
Public Const GLP_CV = 1              ' continuous variable
Public Const GLP_IV = 2              ' long variable
Public Const GLP_BV = 3              ' binary variable

' type of auxiliary/structural variable:
Public Const GLP_FR = 1              ' free variable
Public Const GLP_LO = 2              ' variable with lower bound
Public Const GLP_UP = 3              ' variable with upper bound
Public Const GLP_DB = 4              ' double-bounded variable
Public Const GLP_FX = 5              ' fixed variable

' status of auxiliary/structural variable:
Public Const GLP_BS = 1              ' basic variable
Public Const GLP_NL = 2              ' non-basic variable on lower bound
Public Const GLP_NU = 3              ' non-basic variable on upper bound
Public Const GLP_NF = 4              ' non-basic free variable
Public Const GLP_NS = 5              ' non-basic fixed variable

' scaling options:
Public Const GLP_SF_GM = &H1         ' perform geometric mean scaling
Public Const GLP_SF_EQ = &H10        ' perform equilibration scaling
Public Const GLP_SF_2N = &H20        ' round scale factors to power of two
Public Const GLP_SF_SKIP = &H40      ' skip if problem is well scaled
Public Const GLP_SF_AUTO = &H80      ' choose scaling options automatically

' solution indicator:
Public Const GLP_SOL = 1             ' basic solution
Public Const GLP_IPT = 2             ' interior-point solution
Public Const GLP_MIP = 3             ' mixed long solution

' solution status:
Public Const GLP_UNDEF = 1           ' solution is undefined
Public Const GLP_FEAS = 2            ' solution is feasible
Public Const GLP_INFEAS = 3          ' solution is infeasible
Public Const GLP_NOFEAS = 4          ' no feasible solution exists
Public Const GLP_OPT = 5             ' solution is optimal
Public Const GLP_UNBND = 6           ' solution is unbounded

Public Const GLP_MSG_OFF = 0         ' no output
Public Const GLP_MSG_ERR = 1         ' warning and error messages only
Public Const GLP_MSG_ON = 2          ' normal output
Public Const GLP_MSG_ALL = 3         ' full output
Public Const GLP_MSG_DBG = 4         ' debug output

Public Const GLP_PRIMAL = 1          ' use primal simplex
Public Const GLP_DUALP = 2           ' use dual if it fails, use primal
Public Const GLP_DUAL = 3            ' use dual simplex
Public Const GLP_PT_STD = &H11       ' standard (Dantzig rule)
Public Const GLP_PT_PSE = &H22       ' projected steepest edge
Public Const GLP_RT_STD = &H11       ' standard (textbook)
Public Const GLP_RT_HAR = &H22       ' two-pass Harris' ratio test

Public Const GLP_BR_FFV = 1          ' first fractional variable
Public Const GLP_BR_LFV = 2          ' last fractional variable
Public Const GLP_BR_MFV = 3          ' most fractional variable
Public Const GLP_BR_DTH = 4          ' heuristic by Driebeck and Tomlin
Public Const GLP_BR_PCH = 5          ' hybrid pseudocost heuristic

Public Const GLP_BT_DFS = 1          ' depth first search
Public Const GLP_BT_BFS = 2          ' breadth first search
Public Const GLP_BT_BLB = 3          ' best local bound
Public Const GLP_BT_BPH = 4          ' best projection heuristic

Public Const GLP_PP_NONE = 0         ' disable preprocessing
Public Const GLP_PP_ROOT = 1         ' preprocessing only on root level
Public Const GLP_PP_ALL = 2          ' preprocessing on all levels

Public Type glp_iocp
    ' long optimizer control parameters
     msg_lev As Long    ' message level (see glp_smcp)
     br_tech As Long    ' branching technique:
     bt_tech As Long    ' backtracking technique:
     tol_int(8) As Byte ' mip.tol_int
     tol_obj(8) As Byte ' mip.tol_obj
     tm_lim As Long     ' mip.tm_lim (milliseconds)
     out_frq As Long    ' mip.out_frq (milliseconds)
     out_dly As Long    ' mip.out_dly (milliseconds)
     cb_func As Long    ' mip.cb_func
     cb_info As Long    ' mip.cb_info
     cb_size As Long    ' mip.cb_size
     pp_tech As Long    ' preprocessing technique:
     mip_gap(8) As Byte ' relative MIP gap tolerance
     mir_cuts As Long   ' MIR cuts       (GLP_ON/GLP_OFF)
     gmi_cuts As Long   ' Gomory's cuts  (GLP_ON/GLP_OFF)
     cov_cuts As Long   ' cover cuts     (GLP_ON/GLP_OFF)
     clq_cuts As Long   ' clique cuts    (GLP_ON/GLP_OFF)
     presolve As Long   ' enable/disable using MIP presolver
     binarize As Long   ' try to binarize long variables
     fp_heur As Long    ' feasibility pump heuristic
     foo_bar(29) As Double ' (reserved)
End Type

Public Type glp_smcp
     ' simplex method control parameters
     msg_lev As Long       ' message level:
     meth As Long          ' simplex method option:
     pricing As Long       ' pricing technique:
     r_test As Long        ' ratio test technique:
     tol_bnd As Double     ' spx.tol_bnd
     tol_dj As Double      ' spx.tol_dj
     tol_piv As Double     ' spx.tol_piv
     obj_ll As Double      ' spx.obj_ll
     obj_ul As Double      ' spx.obj_ul
     it_lim As Long        ' spx.it_lim
     tm_lim As Long        ' spx.tm_lim (milliseconds)
     out_frq As Long       ' spx.out_frq
     out_dly As Long       ' spx.out_dly (milliseconds)
     presolve As Long      ' enable/disable using LP presolver
     foo_bar(35) As Double ' (reserved)
End Type

' Problem creating and modifying routines
Declare Function glp_create_prob Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" () As Long
Declare Sub glp_set_prob_name Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByRef name As Byte)
Declare Sub glp_set_obj_name Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByRef name As Byte)
Declare Sub glp_set_obj_dir Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal dir As Long)
Declare Sub glp_set_obj_coef Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal col As Long, ByVal val As Double)
Declare Sub glp_delete_prob Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long)
Declare Function glp_add_rows Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal count As Long) As Long
Declare Function glp_add_cols Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal count As Long) As Long
Declare Sub glp_set_col_name Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal col As Long, ByRef name As Byte)
Declare Sub glp_set_col_kind Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal col As Long, ByVal kind As Long)
Declare Sub glp_set_col_bnds Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal col As Long, ByVal typ As Long, ByVal lb As Double, ByVal ub As Double)
Declare Sub glp_set_row_name Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal row As Long, ByRef name As Byte)
Declare Sub glp_set_row_kind Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal row As Long, ByVal kind As Long)
Declare Sub glp_set_row_bnds Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal row As Long, ByVal typ As Long, ByVal lb As Double, ByVal ub As Double)
Declare Sub glp_set_mat_row Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" ( _
  ByVal lp As Long, ByVal row As Long, ByVal length As Long, ByRef ind As Long, ByRef val As Double)

' LP basis construction routines
Declare Sub glp_adv_basis Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal flags As Long)
Declare Sub glp_cpx_basis Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long)
Declare Sub glp_std_basis Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long)

' Simplex method routines
Declare Function glp_init_smcp Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByRef smcp As glp_smcp) As Long
Declare Function glp_simplex Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByRef smcp As glp_smcp) As Long

' Mixed long programming routines
Declare Sub glp_init_iocp Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByRef smcp As glp_iocp)
Declare Function glp_intopt Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByRef iocp As glp_iocp) As Long

' Problem retrieving functions
Declare Function glp_get_prob_name Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long) As Long
Declare Function glp_get_obj_name Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long) As Long
Declare Function glp_get_obj_val Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long) As Double
Declare Function glp_mip_obj_val Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long) As Double
Declare Function glp_get_num_cols Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long) As Long
Declare Function glp_get_col_name Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal col As Long) As Long
Declare Function glp_get_col_prim Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal col As Long) As Double
Declare Function glp_mip_col_val Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal col As Long) As Double

' Problem reading/writing routines
Declare Function glp_write_lp Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal lp As Long, ByVal parm As Long, ByRef name As Byte) As Long

' Miscellaneous API routines
Declare Function glp_version Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" () As Long
Declare Sub glp_term_hook Lib "c:\temp\glpk-4.37\w32\glpk_4_37.dll" (ByVal func As Long, ByVal info As Long)

Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal pwsz As Long, ByVal length As Long) As String

Sub str2bytes(str As String, b() As Byte)
  Dim i, ii, nn As Long
  ii = LBound(b)
  nn = UBound(b) - ii + 1
  If Len(str) < nn Then
    nn = Len(str)
  End If
  For i = ii To nn - 1
    b(i) = Asc(Mid(str, i + 1, 1))
  Next i
  b(i) = 0
End Sub

' Write simplex solution to debug output
' @param lp problem
Sub write_lp_solution(lp As Long)
  Dim i, n As Long
  Dim l As Long
  Dim name As String
  Dim val As Double
        
  l = glp_version()
  name = SysAllocStringByteLen(l, 512)
  name = Left$(name, InStr(name, Chr$(0)) - 1)
  Debug.Print "GLPK " & name
  
  l = glp_get_prob_name(lp)
  name = SysAllocStringByteLen(l, 512)
  name = Left$(name, InStr(name, Chr$(0)) - 1)
  Debug.Print "Solution of " & name
          
  l = glp_get_obj_name(lp)
  name = SysAllocStringByteLen(l, 512)
  name = Left$(name, InStr(name, Chr$(0)) - 1)
  val = glp_get_obj_val(lp)
  Debug.Print name & " = " & val
          
  n = glp_get_num_cols(lp)
  For i = 1 To n
     l = glp_get_col_name(lp, i)
     name = SysAllocStringByteLen(l, 512)
     name = Left$(name, InStr(name, Chr$(0)) - 1)
     val = glp_get_col_prim(lp, i)
     Debug.Print name & " = " & val
   Next i
End Sub

' Write mixed integer solution to debug output
' @param lp problem
Sub write_mip_solution(lp As Long)
  Dim i, n As Long
  Dim l As Long
  Dim name As String
  Dim val As Double
        
  l = glp_version()
  name = SysAllocStringByteLen(l, 512)
  name = Left$(name, InStr(name, Chr$(0)) - 1)
  Debug.Print "GLPK " & name
  
  l = glp_get_prob_name(lp)
  name = SysAllocStringByteLen(l, 512)
  name = Left$(name, InStr(name, Chr$(0)) - 1)
  Debug.Print "Solution of " & name
          
  l = glp_get_obj_name(lp)
  name = SysAllocStringByteLen(l, 512)
  name = Left$(name, InStr(name, Chr$(0)) - 1)
  val = glp_mip_obj_val(lp)
  Debug.Print name & " = " & val
          
  n = glp_get_num_cols(lp)
  For i = 1 To n
     l = glp_get_col_name(lp, i)
     name = SysAllocStringByteLen(l, 512)
     name = Left$(name, InStr(name, Chr$(0)) - 1)
     val = glp_mip_col_val(lp, i)
     Debug.Print name & " = " & val
   Next i
End Sub