changeset 5233:bdf892d3b024

[project @ 2005-03-22 17:44:31 by jwe]
author jwe
date Tue, 22 Mar 2005 17:44:32 +0000
parents 9b776f5a33eb
children a791b8b777e4
files scripts/ChangeLog scripts/optimization/glpk.m
diffstat 2 files changed, 158 insertions(+), 176 deletions(-) [+]
line wrap: on
line diff
--- a/scripts/ChangeLog	Tue Mar 22 16:18:26 2005 +0000
+++ b/scripts/ChangeLog	Tue Mar 22 17:44:32 2005 +0000
@@ -1,5 +1,12 @@
 2005-03-22  John W. Eaton  <jwe@octave.org>
 
+	* optimization/glpk.m: Adapt to Octave coding style.
+	No need for varargout or varargin.
+	Print usage message if nargin > 11.
+	Allow any value of nargout.
+	Use repmat (C, nr, nc) instead of char (C * ones (nr, nc)).
+	Avoid looping when checking character classes.
+
 	* optimization: New directory.
 	* Makefile.in (SUBDIRS): Add it to the list.
 	* optimization/Makefile.in: New file.
--- a/scripts/optimization/glpk.m	Tue Mar 22 16:18:26 2005 +0000
+++ b/scripts/optimization/glpk.m	Tue Mar 22 17:44:32 2005 +0000
@@ -1,4 +1,22 @@
-function varargout=glpk(varargin)
+## Copyright (C) 2005 Nicolo' Giorgetti
+##
+## This file is part of Octave.
+##
+## Octave is free software; you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2, or (at your option)
+## any later version.
+##
+## Octave is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING.  If not, write to the Free
+## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+## 02111-1307, USA.
+
 ## GLPK - An Octave Interface for the GNU GLPK library
 ##
 ## This routine calls the glpk library to solve an LP/MIP problem. A typical
@@ -11,9 +29,9 @@
 ##                 {x >= LB}
 ##
 ## The calling syntax is:
-## [XOPT,FOPT,STATUS,EXTRA]=glpkmex(SENSE,C,...
-##                                      A,B,CTYPE,LB,UB,...
-##                                      VARTYPE,PARAM,LPSOLVER,SAVE)
+## [XOPT,FOPT,STATUS,EXTRA]=glpk(SENSE,C,...
+##                               A,B,CTYPE,LB,UB,...
+##                               VARTYPE,PARAM,LPSOLVER,SAVE)
 ##
 ## For a quick reference to the syntax just type glpk at command prompt.
 ##
@@ -75,10 +93,10 @@
 ## FOPT:      The optimum.
 ##
 ## STATUS:    Status of the optimization.
-##     
+##
 ##              - Simplex Method -
-##              Value   Code     
-##              180     LPX_OPT     solution is optimal   
+##              Value   Code
+##              180     LPX_OPT     solution is optimal
 ##              181     LPX_FEAS    solution is feasible
 ##              182     LPX_INFEAS  solution is infeasible
 ##              183     LPX_NOFEAS  problem has no feasible solution
@@ -91,7 +109,7 @@
 ##              151     LPX_T_OPT   the interior point method is optimal
 ##              *  Note that additional status codes may appear in
 ##              the future versions of this routine *
-##    
+##
 ##              - Mixed Integer Method -
 ##              Value   Code
 ##              170     LPX_I_UNDEF  the status is undefined
@@ -99,7 +117,7 @@
 ##              172     LPX_I_FEAS   solution integer feasible but
 ##                                   its optimality has not been proven
 ##              173     LPX_I_NOFEAS no integer feasible solution
-##              
+##
 ## EXTRA:     A data structure containing the following fields:
 ##             LAMBDA     Dual variables
 ##             REDCOSTS   Reduced Costs
@@ -107,7 +125,7 @@
 ##             MEM        Memory (in bytes) used for solving LP/MIP problem.
 ##
 ##
-## In case of error the glpkmex returns one of the
+## In case of error the glpk returns one of the
 ## following codes (these codes are in STATUS). For more informations on
 ## the causes of these codes refer to the GLPK reference manual.
 ##
@@ -123,187 +141,144 @@
 ## 212    LPX_E_NOCONV no convergence (interior)
 ## 213    LPX_E_NOPFS  no primal feas. sol. (LP presolver)
 ## 214    LPX_E_NODFS  no dual feas. sol.   (LP presolver)
-##
 
-% --- CODE ---
-% If there is no input output the version and syntax
-if nargin==0
-	printf("glpk: An Octave interface to the GLPK library\n");
-	printf("Version: 1.0\n");
-	printf("\nSyntax: [xopt,fopt,status,extra]=glpk(sense,c,a,b,ctype,lb,ub,vartype,param,lpsolver,save)\n");
-	return;
-endif
+## Author: Nicolo' Giorgetti <giorgetti@dii.unisi.it>
+## Adapted-by: jwe
 
-% If there are less than 4 arguments output an error message
-if nargin<4
-	error("At least 4 inputs required (sense,c,a,b)\n");
-	return;
-endif
+function [xopt, fmin, status, extra] = glpk (sense, c, a, b, ctype, lb, ub, vartype, param, lpsolver, savepb)
 
-% At least 2 outputs required
-if nargout<2
-	error("2 outputs required\n");
-	return;
-endif
-
-% 1) Sense of optimization
-sense=varargin{1};
+  ## If there is no input output the version and syntax
+  if (nargin < 4 || nargin > 11)
+    usage ("[xopt, fopt, status, extra] = glpk (sense, c, a, b, ctype, lb, ub, vartype, param, lpsolver, savepb");
+    return;
+  endif
 
-% 2) Cost vector
-c=varargin{2};
+  if (all (size (c) > 1) || iscomplex (c) || ischar (c))
+    error ("C must be a real vector");
+    return;
+  endif
+  nx = length (c);
+  ## Force column vector.
+  c = c(:);
 
-if (all(size(c)>1) | iscomplex(c) | ischar(c))
-	error("C must be a real vector\n");
-	return;
-endif
-nx=length(c);
-if size(c,1) ~= nx
-	c=c';
-endif
+  ## 3) Matrix constraint
 
-% 3) Matrix constraint
-a=varargin{3};
-if isempty(a)
-	error("A cannot be an empty matrix\n");
-	return;
-endif
-[nc, nxa]=size(a);
-if (ischar(a) | iscomplex(a) | (nxa ~= nx))
-	error("A must be a real valued %d by %d matrix\n",nc,nx);
-	return;
-endif
+  if (isempty (a))
+    error ("A cannot be an empty matrix");
+    return;
+  endif
+  [nc, nxa] = size(a);
+  if (! isreal (a) || nxa != nx)
+    error ("A must be a real valued %d by %d matrix", nc, nx);
+    return;
+  endif
+
+  ## 4) RHS
 
-% 4) RHS
-b=varargin{4};
-if isempty(b)
-	error("B cannot be an empty vector\n");
-	return;
-endif
-if (ischar(b) | iscomplex(b) | (length(b) ~= nc))
-	error("B must be a real valued %d by 1 vector\n",nc);
-	return;
-endif
+  if (isempty (b))
+    error ("B cannot be an empty vector");
+    return;
+  endif
+  if (! isreal (b) || length (b) != nc)
+    error ("B must be a real valued %d by 1 vector", nc);
+    return;
+  endif
+
+  ## 5) Sense of each constraint
 
-% 5) Sense of each constraint
-ctype=[];
-if nargin>4 
-	ctype=varargin{5};
-	if isempty(ctype)
-		ctype=char('U'*ones(nc,1));
-	elseif (isnumeric(ctype) | all(size(ctype)>1) | (length(ctype) ~= nc))
-		error("CTYPE must be a char valued %d by 1 column vector\n",nc);
-		return;
-	else
-		for i=1:nc
-			if (ctype(i)!='F' & ctype(i)!='U' & ctype(i)!='S' & ctype(i)!='L' & ctype(i)!='D')
-				error("CTYPE must contain only F,U,S,L and D\n");
-				return;
-			endif
-		endfor
-	endif
-else
-	ctype=char('U'*ones(nc,1));
-end
+  if (nargin > 4)
+    if (isempty (ctype))
+      ctype = repmat ("U", nc, 1);
+    elseif (! ischar (ctype) || all (size (ctype) > 1) || length (ctype) != nc)
+      error ("CTYPE must be a char valued %d by 1 column vector", nc);
+      return;
+    elseif (! all (ctype == "F" | ctype == "U" | ctype == "S"
+		   | ctype == "L" | ctype == "D"))
+      error ("CTYPE must contain only F, U, S, L, or D");
+      return;
+    endif
+  else
+    ctype = repmat ("U", nc, 1);
+  end
+
+  ## 6) Vector with the lower bound of each variable
 
-% 6) Vector with the lower bound of each variable
-lb=[];
-if nargin>5
-	lb=varargin{6};
-	if isempty(lb)
-		lb=-Inf*ones(nx,1);
-	elseif (ischar(lb) | iscomplex(lb) | all(size(lb)>1) | (length(lb)~=nx))
-		error("LB must be a real valued %d by 1 column vector\n",nx);
-		return;
-	endif
-else
-	lb=-Inf*ones(nx,1);
-end
+  if (nargin > 5)
+    if (isempty (lb))
+      lb = repmat (-Inf, nx, 1);
+    elseif (! isreal (lb) || all (size (lb) > 1) || length (lb) != nx)
+      error ("LB must be a real valued %d by 1 column vector", nx);
+      return;
+    endif
+  else
+    lb = repmat (-Inf, nx, 1);
+  end
+
+  ## 7) Vector with the upper bound of each variable
 
-% 7) Vector with the upper bound of each variable
-ub=[];
-if nargin>6
-	ub=varargin{7};
-	if isempty(ub)
-		ub=Inf*ones(nx,1);
-	elseif (ischar(ub) | iscomplex(ub) | all(size(ub)>1) | (length(ub)~=nx))
-		error("UB must be a real valued %d by 1 column vector\n",nx);
-		return;
-	endif
-else
-	ub=Inf*ones(nx,1);
-end
+  if (nargin > 6)
+    if (isempty (ub))
+      ub = repmat (Inf, nx, 1);
+    elseif (! isreal (ub) || all (size (ub) > 1) || length (ub) != nx)
+      error ("UB must be a real valued %d by 1 column vector", nx);
+      return;
+    endif
+  else
+    ub = repmat (Inf, nx, 1);
+  end
 
-% 8) Vector with the type of variables 
-vartype=[];
-if nargin>7
-	vartype=varargin{8};
-	if isempty(vartype)
-		vartype=char('C'*ones(nx,1));
-	elseif (isnumeric(vartype) | all(size(vartype)>1) | (length(vartype)~=nx))
-		error("VARTYPE must be a char valued %d by 1 column vector\n",nx);
-		return;
-	else
-		for i=1:nx
-			if (vartype(i)!='C' & vartype(i)!='I')
-				error("VARTYPE must contain only C or I\n");
-				return;
-			endif
-		endfor
-	endif
-else
-	vartype=char('C'*ones(nx,1)); % As default we consider continuous vars
-endif
+  ## 8) Vector with the type of variables
 
-% 9) Parameters vector
-param=[];
-if nargin>8
-	param=varargin{9};
-	if !isstruct(param)
-		error("PARAM must be a structure\n");
-		return;
-	endif
-else
-	param=struct;
-endif
+  if (nargin > 7)
+    if isempty (vartype)
+      vartype = repmat ("C", nx, 1);
+    elseif (! ischar (vartype) || all (size (vartype) > 1)
+	    || length (vartype) != nx)
+      error ("VARTYPE must be a char valued %d by 1 column vector", nx);
+      return;
+    elseif (! all (vartype == "C" | vartype == "I"))
+      error ("VARTYPE must contain only C or I");
+      return;
+    endif
+  else
+    ## As default we consider continuous vars
+    vartype = repmat ("C", nx, 1);
+  endif
 
-% 10) Select solver method: simplex or interior point
-lpsolver=[];
-if nargin>9
-	lpsolver=varargin{10};
-	if (!isnumeric(lpsolver) | all(size(lpsolver)>1))
-		error("LPSOLVER must be a real scalar value\n");
-		return;
-	endif
-else
-	lpsolver=1;
-endif
+  ## 9) Parameters vector
+
+  if (nargin > 8)
+    if (! isstruct (param))
+      error ("PARAM must be a structure");
+      return;
+    endif
+  else
+    param = struct ();
+  endif
 
-% 11) Save the problem
-savepb=[];
-if nargin>10
-	savepb=varargin{11};
-	if (!isnumeric(savepb) | all(size(savepb)>1))
-		error("LPSOLVER must be a real scalar value\n");
-		return;
-	endif
-else
-	savepb=0;
-end
+  ## 10) Select solver method: simplex or interior point
+
+  if (nargin > 9)
+    if (! (isreal (lpsolver) && isscalar (lpsolver)))
+      error ("LPSOLVER must be a real scalar value");
+      return;
+    endif
+  else
+    lpsolver = 1;
+  endif
+
+  ## 11) Save the problem
 
-if nargin>11
-	warning("Extra parameters ignored\n");
-endif
+  if (nargin > 10)
+    if (! (isreal (savepb) && isscalar (lpsolver)))
+      error ("LPSOLVER must be a real scalar value");
+      return;
+    endif
+  else
+    savepb = 0;
+  end
 
-try
-	[xopt, fmin, status, extra]=glpkoct(sense,c,a,b,ctype,lb,ub,vartype,param,lpsolver,savepb);
-catch
-	error("Problems with glpkoct");
-end_try_catch
+  [xopt, fmin, status, extra] = ...
+    __glpk__ (sense, c, a, b, ctype, lb, ub, vartype, param, lpsolver, savepb);
 
-varargout{1}=xopt;
-varargout{2}=fmin;
-varargout{3}=status;
-varargout{4}=extra;
-
-	
 endfunction