source: project/release/4/glpk/trunk/glpk-eggdoc.scm @ 14401

Last change on this file since 14401 was 14401, checked in by Ivan Raikov, 11 years ago

glpk ported to Chicken 4

File size: 20.5 KB
Line 
1
2(use eggdoc sxml-transforms srfi-13)
3
4(define (s+ . rest) (string-concatenate (map ->string rest)))
5(define (sw+ w lst) (string-intersperse (map ->string lst) w))
6
7(define (make-lpx-parameter-doc name typ comment )
8  (if (list? typ)
9      (let ((variants (map cadr typ)))
10        `(procedure ,(s+ "lpx:" name ":: LPX [ * (" (sw+ " | " variants) ")] -> LPX | VALUE")
11                    ,comment))
12      `(procedure ,(s+ "lpx:" name ":: LPX [ * " (string-upcase (->string typ)) "] -> LPX | VALUE")
13                  ,comment)))
14
15         
16
17(define doc
18  `((eggdoc:begin
19     (name "glpk")
20     (description "GNU Linear Programming Kit (GLPK)")
21     (author (url "http://chicken.wiki.br/users/ivan-raikov" "Ivan Raikov"))
22
23     (history 
24      (version "1.2" "Ported to Chicken 4")
25      (version "1.1" "Added chicken-glpk.h to file manifest")
26      (version "1.0" "Initial release"))
27
28     (requires)
29
30     (usage "(require-extension glpk)")
31
32     (download "glpk.egg")
33
34     (documentation
35     
36      (p (url "http://www.gnu.org/software/glpk/" "GLPK")
37         " is a package for solving linear programming and mixed integer programming problems. " )
38
39      (p "The Chicken GLPK egg provides a Scheme interface to "
40         "a large subset of the GLPK procedures for problem setup and solving.  "
41         "Below is a list of procedures that are included in this egg, "
42         "along with brief descriptions. This egg has been tested with "
43         "GLPK version 4.28. ")
44
45      (subsection "Problem constructors and predicates"
46
47          (procedure "lpx:empty-problem:: () -> LPX"
48                     (p "This procedure creates a new problem that has no rows or columns."))
49
50          (procedure "lpx:make-problem:: DIR * PBOUNDS * XBOUNDS * OBJCOEFS * CONSTRAINTS * [ORDER] -> LPX"
51                     ((p "This procedure creates a new problem with the specified parameters. ")
52                     (ul 
53                      (li "Argument " (tt "DIR") " specifies the optimization direction flag. It can be "
54                          "one of " (tt "'maximize") " or  " (tt "'minimize") ". ")
55                      (li "Argument " (tt "PBOUNDS") " is a list that specifies the type and bounds "
56                          "for each row of the problem object. Each element of this list can take one "
57                          "of the following forms: " 
58                          (symbol-table 
59                            (describe "'(unbounded)" 
60                                      ("Free (unbounded) variable, " (tt "-Inf <= x <= +Inf")))
61                            (describe "'(lower-bound LB)" 
62                                      ("Variable with lower bound, " (tt "LB <= x <= +Inf")))
63                            (describe "'(upper-bound UB)" 
64                                      ("Variable with upper bound, " (tt "-Inf <= x <= UB")))
65                            (describe "'(double-bounded LB UB)" 
66                                      ("Double-bounded variable, " (tt "LB <= x <= UB")))
67                            (describe "'(fixed LB UB)" 
68                                      ("Fixed variable, " (tt "LB = x = UB")))))
69                      (li "Argument " (tt "XBOUNDS") " is a list that specifies the type and bounds "
70                          "for each column (structural variable) of the problem object. "
71                          "Each element of this list can take one of the forms described for parameter "
72                          (tt "PBOUNDS") ". ")
73                      (li "Argument " (tt "OBJCOEFS") " is a list that specifies the objective coefficients "
74                          "for each column (structural variable). This list must be of the same length as "
75                          (tt "XBOUNDS") ". ")
76                      (li "Argument " (tt "OBJCOEFS") " is a list that specifies the objective coefficients "
77                          "for each column (structural variable). ")
78                      (li "Argument " (tt "CONSTRAINTS") " is an SRFI-4 " (tt "f64vector") " that represents "
79                          "the problem's constraint matrix (in row-major or column-major order). ")
80                      (li "Optional argument " (tt "ORDER") " specifies the element order of the constraints matrix. " 
81                          "It can be one of " (tt "'row-major") " or " (tt "'column-major") ". ")
82                      )))
83
84          (procedure "lpx?:: OBJECT -> BOOL"
85                     (p "Returns true if the given object was created by " (tt "lpx:empty-problem") " or "
86                        (tt "lpx:make-problem") ", false otherwise. " ))
87
88
89          )  ;; end subsection
90     
91
92      (subsection "Problem accessors and modifiers"
93                 
94                  (procedure "lpx:set-problem-name:: LPX * NAME -> LPX"
95                             "Sets problem name. ")
96                  (procedure "lpx:get-problem-name:: LPX -> NAME"
97                             "Returns the name of the given problem. ")
98                 
99                  (procedure "lpx:set-direction:: LPX * DIR -> LPX"
100                             ("Specifies the optimization direction flag, which can be "
101                              "one of " (tt "'maximize") " or  " (tt "'minimize") ". "))
102                  (procedure "lpx:get-direction:: LPX -> DIR"
103                             "Returns the optimization direction for the given problem. ")
104                 
105                  (procedure "lpx:set-class:: LPX * CLASS -> LPX"
106                             ("Sets problem class (linear programming or mixed-integer programming. "
107                              "Argument " (pp "CLASS") " can be one of " (tt "'lp") " or " (tt "'mip") ". "))
108
109                  (procedure "lpx:get-class:: LPX -> CLASS"
110                             "Returns the problem class. ")
111                 
112                  (procedure "lpx:add-rows:: LPX * N -> LPX"
113                             ("This procedure adds " (tt "N") " rows (constraints) to the given problem. "
114                              "Each new row is initially unbounded and has an empty list of constraint "
115                              "coefficients. "))
116
117                  (procedure "lpx:add-columns:: LPX * N -> LPX"
118                             ("This procedure adds " (tt "N") " columns (structural variables) to the given problem. "))
119                 
120                  (procedure "lpx:set-row-name:: LPX * I * NAME -> LPX"
121                             "Sets the name of row " (tt "I") ".")
122
123                  (procedure "lpx:set-column-name:: LPX * J * NAME -> LPX"
124                             "Sets the name of column " (tt "J") ".")
125
126                  (procedure "lpx:get-row-name:: LPX * I -> NAME"
127                             "Returns the name of row " (tt "I") ".")
128
129                  (procedure "lpx:get-column-name:: LPX * J -> NAME"
130                             "Returns the name of column " (tt "J") ".")
131
132                  (procedure "lpx:get-num-rows:: LPX -> N"
133                             "Returns the current number of rows in the given problem. ")
134
135                  (procedure "lpx:get-num-columns:: LPX -> N"
136                             "Returns the current number of columns in the given problem. ")
137
138                  (procedure "lpx:set-row-bounds:: LPX * I * BOUNDS -> LPX"
139                             ("Sets bounds for row " (tt "I") " in the given problem. "
140                              "Argument " (tt "BOUNDS") " specifies the type and bounds "
141                              "for the specified row. It can take one of the following forms: " 
142                              (symbol-table 
143                               (describe "'(unbounded)" 
144                                         ("Free (unbounded) variable, " (tt "-Inf <= x <= +Inf")))
145                               (describe "'(lower-bound LB)" 
146                                         ("Variable with lower bound, " (tt "LB <= x <= +Inf")))
147                               (describe "'(upper-bound UB)" 
148                                         ("Variable with upper bound, " (tt "-Inf <= x <= UB")))
149                               (describe "'(double-bounded LB UB)" 
150                                         ("Double-bounded variable, " (tt "LB <= x <= UB")))
151                               (describe "'(fixed LB UB)" 
152                                         ("Fixed variable, " (tt "LB = x = UB"))))))
153
154                  (procedure "lpx:set-column-bounds:: LPX * J * BOUNDS -> LPX"
155                             ("Sets bounds for column " (tt "J") " in the given problem. "
156                              "Argument " (tt "BOUNDS") " specifies the type and bounds "
157                              "for the specified column. It can take one of the following forms: " 
158                              (symbol-table 
159                               (describe "'(unbounded)" 
160                                         ("Free (unbounded) variable, " (tt "-Inf <= x <= +Inf")))
161                               (describe "'(lower-bound LB)" 
162                                         ("Variable with lower bound, " (tt "LB <= x <= +Inf")))
163                               (describe "'(upper-bound UB)" 
164                                         ("Variable with upper bound, " (tt "-Inf <= x <= UB")))
165                               (describe "'(double-bounded LB UB)" 
166                                         ("Double-bounded variable, " (tt "LB <= x <= UB")))
167                               (describe "'(fixed LB UB)" 
168                                         ("Fixed variable, " (tt "LB = x = UB"))))))
169
170                  (procedure "lpx:set-objective-coefficient:: LPX * J * COEF -> LPX"
171                             "Sets the objective coefficient at column " (tt "J") " (structural variable). ")
172                 
173                  (procedure "lpx:set-column-kind:: LPX * J * KIND -> LPX"
174                             ("Sets the kind of column " (tt "J") " (structural variable). "
175                              "Argument " (tt "KIND") " can be one of the following: "
176                              (symbol-table
177                               (describe "'iv" "integer variable")
178                               (describe "'cv" "continuous variable"))))
179                       
180                  (procedure "lpx:load-constraint-matrix:: LPX * F64VECTOR * NROWS * NCOLS [* ORDER] -> LPX"
181                             ("Loads the constraint matrix for the given problem. "
182                              "The constraints matrix is represented as an SRFI-4 " (tt "f64vector") 
183                              " (in row-major or column-major order). "
184                              "Optional argument " (tt "ORDER") 
185                              " specifies the element order of the constraints matrix. " 
186                              "It can be one of " (tt "'row-major") " or " (tt "'column-major") ". "))
187                             
188                  (procedure "lpx:get-column-primals:: LPX -> F64VECTOR"
189                             "Returns the primal values of all structural variables (columns). ")
190
191                  (procedure "lpx:get-objective-value:: LPX -> NUMBER"
192                             "Returns the current value of the objective function. ")
193
194
195                  ) ;; end subsection
196
197      (subsection "Problem control parameters"
198
199                  (p "The procedures in this section retrieve or set control parameters of GLPK problem object. "
200                     "If a procedure is invoked only with a problem object as an argument, it will return "
201                     "the value of its respective control parameter. If it is invoked with an additional argument, "
202                     "that argument is used to set a new value for the control parameter. ")
203
204                 
205                  ,(make-lpx-parameter-doc
206                    'message_level `((0 none) (1 error) (2 normal) (3 full))
207                    "Level of messages output by solver routines."
208                    )
209
210                  ,(make-lpx-parameter-doc 
211                    'scaling `((0 none) (1 equilibration) (2 geometric-mean) (3 geometric-mean+equilibration))
212                    "Scaling option."
213                    )
214
215                  ,(make-lpx-parameter-doc 
216                    'use_dual_simplex `bool
217                    "Dual simplex option."
218                    )
219                       
220                  ,(make-lpx-parameter-doc 
221                    'pricing `((0 textbook) (1 steepest-edge))
222                    "Pricing option (for both primal and dual simplex)."
223                    )
224
225                  ,(make-lpx-parameter-doc 
226                    'solution_rounding `bool
227                    "Solution rounding option."
228                    )
229
230                  ,(make-lpx-parameter-doc 
231                    'iteration_limit `int
232                    "Simplex iteration limit."
233                    )
234
235                  ,(make-lpx-parameter-doc 
236                    'iteration_count `int
237                    "Simplex iteration count."
238                    )
239
240                  ,(make-lpx-parameter-doc 
241                    'branching_heuristic `((0 first) (1 last) (2 driebeck+tomlin))
242                    "Branching heuristic option (for MIP only)."
243                    )
244
245                  ,(make-lpx-parameter-doc 
246                    'backtracking_heuristic `((0 dfs) (1 bfs) (2 best-projection) (3 best-local-bound))
247                    "Backtracking heuristic option (for MIP only)."
248                    )
249
250                  ,(make-lpx-parameter-doc 
251                    'use_presolver `bool
252                    "Use the LP presolver."
253                    )
254
255                  ,(make-lpx-parameter-doc 
256                    'relaxation `real
257                    "Relaxation parameter used in the ratio test."
258                    )
259                 
260                  ,(make-lpx-parameter-doc 
261                    'time_limit `real
262                    "Searching time limit, in seconds."
263                    )
264
265
266                  ) ;; end subsection
267
268      (subsection "Scaling & solver procedures"
269                 
270                  (procedure "lpx:scale-problem:: LPX -> LPX"
271                             ("This procedure performs scaling of of the constraints matrix in order "
272                              "to improve its numerical properties. ")
273                             )
274                 
275                  (procedure "lpx:simplex:: LPX -> STATUS"
276                             ("This procedure solves the given LP problem using the simplex method.  "
277                              "It can return one of the following status codes: "
278                              (symbol-table
279                               (describe "LPX_E_OK" "the LP problem has been successfully solved")
280
281                               (describe "LPX_E_BADB" "Unable to start
282the search, because the initial basis specified in the problem object
283is invalid--the number of basic (auxiliary and structural) variables
284is not the same as the number of rows in the problem object. ")
285
286                               (describe "LPX_E_SING" "Unable to start
287the search, because the basis matrix corresponding to the initial
288basis is singular within the working precision. ")
289
290                               (describe "LPX_E_COND" "Unable to start
291the search, because the basis matrix corresponding to the initial
292basis is ill-conditioned, i.e. its condition number is too large. ")
293
294                               (describe "LPX_E_BOUND" "Unable to start
295the search, because some double-bounded (auxiliary or structural)
296variables have incorrect bounds. ")
297
298                               (describe "LPX_E_FAIL" "The search was
299prematurely terminated due to the solver failure. ")
300
301                               (describe "LPX_E_OBJLL" "The search was
302prematurely terminated, because the objective function being maximized
303has reached its lower limit and continues decreasing (the dual simplex
304only). ")
305
306                               (describe "LPX_E_OBJUL" "The search was
307prematurely terminated, because the objective function being minimized
308has reached its upper limit and continues increasing (the dual simplex
309only). ")
310
311                               (describe "LPX_E_ITLIM" "The search was
312prematurely terminated, because the simplex iteration limit has been
313exceeded. ")
314
315                               (describe "LPX_E_TMLIM" "The search was
316prematurely terminated, because the time limit has been exceeded. ")
317
318                               (describe "LPX_E_NOPFS" "The LP problem
319instance has no primal feasible solution (only if the LP presolver is used). ")
320
321                               (describe "LPX_E_NODFS" "The LP problem
322instance has no dual feasible solution (only if the LP presolver is used)."))
323                               
324                              ))
325
326
327                  (procedure "lpx:integer:: LPX -> STATUS"
328                             "Solves an MIP problem using the branch-and-bound method. ")
329
330                  ) ;; end subsection
331
332      )
333
334     (examples (pre #<<EOF
335;;
336;; Two Mines Linear programming example from
337;;
338;; http://people.brunel.ac.uk/~mastjjb/jeb/or/basicor.html#twomines
339;;
340
341;; Two Mines Company
342;;
343;; The Two Mines Company owns two different mines that produce an ore
344;; which, after being crushed, is graded into three classes: high,
345;; medium and low-grade. The company has contracted to provide a
346;; smelting plant with 12 tons of high-grade, 8 tons of medium-grade
347;; and 24 tons of low-grade ore per week. The two mines have different
348;; operating characteristics as detailed below.
349;;
350;; Mine    Cost per day ($'000)    Production (tons/day)               
351;;                                High    Medium    Low
352;; X       180                     6       3         4
353;; Y       160                     1       1         6
354;;
355;;                                 Production (tons/week)
356;;                                High    Medium    Low
357;; Contract                       12       8        24
358;;
359;; How many days per week should each mine be operated to fulfill the
360;; smelting plant contract?
361;;
362
363(require-extension srfi-4)
364(require-extension glpk)
365
366;; (1) Unknown variables
367;;
368;;      x = number of days per week mine X is operated
369;;      y = number of days per week mine Y is operated
370;;
371;; (2) Constraints
372;;
373;;
374;;    * ore production constraints - balance the amount produced with
375;;      the quantity required under the smelting plant contract
376;;
377;;      High    6x + 1y >= 12
378;;      Medium  3x + 1y >= 8
379;;      Low     4x + 6y >= 24
380;;
381;; (3) Objective
382;;
383;;     The objective is to minimise cost which is given by 180x + 160y.
384;;
385;;     minimise  180x + 160y
386;;     subject to
387;;         6x + y >= 12
388;;         3x + y >= 8
389;;         4x + 6y >= 24
390;;         x <= 5
391;;         y <= 5
392;;         x,y >= 0
393;;
394;; (4) Auxiliary variables (rows)
395;;
396;;  p = 6x + y
397;;  q = 3x + y
398;;  r = 4x + 6y
399;;
400;;  12 <= p < +inf
401;;   8 <= q < +inf
402;;  24 <= r < +inf
403
404(define pbounds `((lower-bound 12) (lower-bound 8) (lower-bound 24)))
405
406;; (5) Structural variables (columns)
407;;
408;;  0 <= x <= 5
409;;  0 <= y <= 5
410
411(define xbounds  `((double-bounded 0 5) (double-bounded 0 5)))
412
413;; (6) Objective coefficients: 180, 160
414
415(define objcoefs (list 180 160))
416
417
418;; Constraints matrix (in row-major order)
419;;
420;;   6  1   
421;;   3  1   
422;;   4  6   
423
424(define constraints (f64vector 6 1 3 1 4 6))
425
426;; Create the problem definition & run the solver
427(let ((lpp (lpx:make-problem 'minimize pbounds xbounds objcoefs constraints)))
428  (lpx:scale-problem lpp)
429  (lpx:use_presolver lpp #t)
430  (let ((status (lpx:simplex lpp)))
431    (print "solution status = " status)
432    (print "objective value = " (lpx:get-objective-value lpp))
433    (print "primals = " (lpx:get-column-primals lpp))))
434
435EOF
436)
437     (license
438      "Copyright Ivan Raikov and the Okinawa Institute of Science and Technology.
439
440This program is free software: you can redistribute it and/or modify
441it under the terms of the GNU General Public License as published by
442the Free Software Foundation, either version 3 of the License, or (at
443your option) any later version.
444
445This program is distributed in the hope that it will be useful, but
446WITHOUT ANY WARRANTY; without even the implied warranty of
447MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
448General Public License for more details.
449
450A full copy of the GPL license can be found at
451<http://www.gnu.org/licenses/>.")))))
452
453
454(define glpk-eggdoc:css (make-parameter #<<EOF
455 <!--
456      CODE {
457            color: #666666;
458          }
459/*   DT.definition EM { font-weight: bold; font-style: normal; } */
460
461     DT.definition { 
462                   background: #eee;
463                   color: black;
464                   padding: 0.2em 1em 0.2em 0.7em;
465                   margin-left: 0.2em;
466border: 1px solid #bbc;
467                   font-family: "Andale Mono", monospace;
468                   /* font-size: 1.2em; */
469                   
470                 }
471     DD {
472                   margin-top: 0.8em;
473                   margin-bottom: 0.8em;
474     }
475     DIV.subsection {
476                    border-top: 1px solid #448;
477                    padding-left: 1em;
478                    margin-bottom: 1.2em;
479     }
480     DIV.subsubsection {
481                    border-top: 1px dotted #99c;
482                    /* border-left: 1px solid #99c; */
483                    padding-left: 1em;
484                    margin-bottom: 1.2em;
485     }
486     DIV.subsubsubsection {
487                    border-top: 1px solid #ddf;
488                    padding-left: 1em;
489                    margin-bottom: 1.2em;
490     }
491
492         DIV.section {
493                 margin-bottom: 1.5em;
494         }
495         a:link {
496                 color: #336;
497         }
498         a:visited { color: #666; }
499         a:active  { color: #966; }
500         a:hover   { color: #669; }
501         body { margin: 0; padding: 0; background: #fff; color: #000; font: 9pt "Lucida Grande", "Verdana", sans-serif; }
502         H2 {
503                 background: #336;
504                 color: #fff;
505                 padding-top: 0.5em;
506                 padding-bottom: 0.5em;
507                 padding-left: 16px;
508                 margin: 0 0 1em 0;
509        }
510        UL LI {
511                list-style: none;
512        }
513        TT {
514                font-family: "Andale Mono", monospace;
515                /* font-size: 1.2em; */
516        }
517        H3 {
518                color: #113;
519                margin-bottom: 0.5em;
520        }
521        H4, H5, H6 {
522                color: #113;
523                margin-bottom: 1.0em;
524        }
525        H5 {
526                font-weight: normal;
527                font-style: italic;
528                font-size: 100%;
529                margin-top: 1.2em;
530        }
531        H6 {
532                font-weight: bold;
533                font-size: 85%;
534                margin-top: 1.2em;
535        }
536     DIV#eggheader {
537         text-align: center;
538                 float: right;
539                 margin-right: 2em;
540     }
541     DIV#header IMG {
542            /* display: block; margin-left: auto; margin-right: auto;  */
543            /* float: right; */
544            border: none;  /* firefox */
545     }
546     DIV#footer {
547                background: #bbd;
548                padding: 0.7em ;
549                border-top: 1px solid #cce;
550     }
551     DIV#footer hr {
552                display: none;
553     }
554     DIV#footer a {
555                float: left;
556     }
557     DIV#revision-history {
558         float: right;
559     }
560     
561     DIV#body {
562                 margin: 1em 1em 1em 16px;
563         }
564
565     DIV#examples PRE {
566       background: #eef;
567       padding: 0.1em;
568       border: 1px solid #aac;
569     }
570     PRE#license, DIV#examples PRE {
571       padding: 0.5em;
572     }
573     DIV#examples PRE {
574       /* font-size: 85%; */
575     }
576     PRE { font-family: "Andale Mono", monospace; }
577     TABLE {
578       background: #eef;
579       padding: 0.2em;
580       border: 1px solid #aac;
581       border-collapse: collapse;
582       width: 100%;
583     }
584     TABLE.symbol-table TD.symbol {
585          width: 15em;
586          font-family: "Andale Mono", monospace;
587          vertical-align: top;
588          /* font-size: 1.2em; */
589     }
590     TABLE.symbol-table TD {
591          font-family: "Andale Mono", monospace;
592          vertical-align: top;
593          /* font-size: 1.2em; */
594     }
595     TH {
596       text-align: left;
597       border-bottom: 1px solid #aac;
598       padding: 0.25em 0.5em 0.25em 0.5em;
599     } 
600     TD { padding: 0.25em 0.5em 0.25em 0.5em; }
601     -->
602EOF
603))
604
605
606(if (eggdoc->html doc 
607   `( (eggdoc-style . ,(lambda (tag)
608                         `("<style type=\"text/css\">" ,(glpk-eggdoc:css)
609                           "</style>")))
610      (documentation *macro* . ,(lambda (tag . elts)
611                                  (let* ((sections
612                                          (pre-post-order elts
613                                                          `((subsection ;; (subsection level "content ...")
614                                                   ((*text* . ,(lambda (tag str) str)))
615                                                   . ,(lambda (tag head-word . elems)
616                                                        `(li (a (@ (href ,(string-append "#" head-word)))
617                                                                ,head-word))))
618                                                  (*default*
619                                                   . ,(lambda (tag . elems) (list)))
620                                                 
621                                                  (*text* . ,(lambda (trigger str) (list))))))
622                               (toc `(div (@ (class "toc"))
623                                          (ol ,sections))))
624                          `(section "Documentation" ,(cons toc elts)))))
625                      ,@(eggdoc:make-stylesheet doc) ))
626
627    (void))
Note: See TracBrowser for help on using the repository browser.