Hello Curtis,
please, find appended two examples.
Please, load the module files to your VBA project.
glpk.bas contains the library definitions. You will have to adjust the
path to the glpk libary.
lp.bas contains a linear problem.
mip.bas contains a mixed integer problem.
The definitions assume that you are using a 32bit system. Cf.
https://support.office.com/en-us/article/What-version-of-Office-am-I-using-932788b8-a3ce-44bf-bb09-e334518b8b19
Best regards
Heinrich Schuchardt
On 01/04/2017 10:40 PM, Andrew Makhorin wrote:
> -------- Forwarded Message --------
> To: [email protected] <[email protected]>
> Subject: VBA dll call
> Date: Wed, 4 Jan 2017 19:34:29 +0000
>
> Hello,
>
> I have been working with the GLPK API. I can get most of the functions
> working except when it comes to matrices.
>
> I am trying to fill up the constraint matrix, and it errors out and
> shuts down Excel.
>
> Are there any obvious mistakes?>
> Thanks for all of your hard work,
>
> Curtis Passorelli
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
Attribute VB_Name = "lp"
Option Explicit
' Minimize z = -.5 * x1 + .5 * x2 - x3 + 1
'
' subject to
' 0.0 <= x1 - .5 * x2 <= 0.2
' -x2 + x3 <= 0.4
' where,
' 0.0 <= x1 <= 0.5
' 0.0 <= x2 <= 0.5
' 0.0 <= x3 <= 0.5
Sub lp()
Dim lp As Long
Dim smcp As glp_smcp
Dim ret As Long
Dim name(36) As Byte
Dim ind(2) As Long
Dim val(2) As Double
' Create problem
lp = glp_create_prob()
str2bytes "Linear Problem", name
glp_set_prob_name lp, name(0)
' Create columns
glp_add_cols lp, 3
str2bytes "x1", name
glp_set_col_name lp, 1, name(0)
glp_set_col_kind lp, 1, GLP_CV
glp_set_col_bnds lp, 1, GLP_DB, 0#, 0.5
str2bytes "x2", name
glp_set_col_name lp, 2, name(0)
glp_set_col_kind lp, 2, GLP_CV
glp_set_col_bnds lp, 2, GLP_DB, 0#, 0.5
str2bytes "x3", name
glp_set_col_name lp, 3, name(0)
glp_set_col_kind lp, 3, GLP_CV
glp_set_col_bnds lp, 3, GLP_DB, 0#, 0.5
' Create rows
glp_add_rows lp, 2
str2bytes "c1", name
glp_set_row_name lp, 1, name(0)
glp_set_row_bnds lp, 1, GLP_DB, 0, 0.2
ind(1) = 1
ind(2) = 2
val(1) = 1#
val(2) = -0.5
glp_set_mat_row lp, 1, 2, ind(0), val(0)
str2bytes "c2", name
glp_set_row_name lp, 2, name(0)
glp_set_row_bnds lp, 2, GLP_UP, 0, 0.4
ind(1) = 2
ind(2) = 3
val(1) = -1
val(2) = 1
glp_set_mat_row lp, 2, 2, ind(0), val(0)
' Define objective
str2bytes "obj", name
glp_set_obj_name lp, name(0)
glp_set_obj_dir lp, GLP_MIN
glp_set_obj_coef lp, 0, 1#
glp_set_obj_coef lp, 1, -0.5
glp_set_obj_coef lp, 2, 0.5
glp_set_obj_coef lp, 3, -1
' Write model to file
str2bytes "c:\temp\lp.lp", name
ret = glp_write_lp(lp, 0, name(0))
' Solve model
ret = glp_init_smcp(smcp)
ret = glp_simplex(lp, smcp)
'Retrieve solution
If ret = 0 Then
write_lp_solution (lp)
End If
glp_delete_prob lp
End Sub
Attribute VB_Name = "mip"
Option Explicit
' Maximize z = 17 * x1 + 12* x2
' subject to
' 10 x1 + 7 x2 <= 40
' x1 + x2 <= 5
' where,
' 0.0 <= x1 integer
' 0.0 <= x2 integer
Sub mip()
Dim lp As Long
Dim iocp As glp_iocp
Dim ind(2) As Long
Dim val(2) As Double
Dim ret As Integer
Dim name(36) As Byte
' Create problem
lp = glp_create_prob()
str2bytes "Mixed Integer Problem", name
glp_set_prob_name lp, name(0)
' Define columns
glp_add_cols lp, 2
str2bytes "x1", name
glp_set_col_name lp, 1, name(0)
glp_set_col_kind lp, 1, GLP_IV
glp_set_col_bnds lp, 1, GLP_LO, 0#, 0#
str2bytes "x2", name
glp_set_col_name lp, 2, name(0)
glp_set_col_kind lp, 2, GLP_IV
glp_set_col_bnds lp, 2, GLP_LO, 0#, 0#
' Create constraints
glp_add_rows lp, 2
str2bytes "c1", name
glp_set_row_name lp, 1, name(0)
glp_set_row_bnds lp, 1, GLP_UP, 0, 40#
ind(1) = 1
ind(2) = 2
val(1) = 10#
val(2) = 7#
glp_set_mat_row lp, 1, 2, ind(0), val(0)
str2bytes "c2", name
glp_set_row_name lp, 2, name(0)
glp_set_row_bnds lp, 2, GLP_UP, 0, 5#
ind(1) = 1
ind(2) = 2
val(1) = 1#
val(2) = 1#
glp_set_mat_row lp, 2, 2, ind(0), val(0)
' Define objective
str2bytes "obj", name
glp_set_obj_name lp, name(0)
glp_set_obj_dir lp, GLP_MAX
glp_set_obj_coef lp, 0, 0#
glp_set_obj_coef lp, 1, 17#
glp_set_obj_coef lp, 2, 12#
' Write model to file
str2bytes "c:\temp\mip.lp", name
ret = glp_write_lp(lp, 0, name(0))
' Solve model
glp_init_iocp iocp
iocp.presolve = GLP_ON
ret = glp_intopt(lp, iocp)
' Retrieve solution
If ret = 0 Then
write_mip_solution (lp)
Else
Debug.Print "The problem could not be solved"
End If
' Free memory
glp_delete_prob lp
End Sub
_______________________________________________
Help-glpk mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/help-glpk
