[m-rev.] diff: cleanup lp.m
Julien Fischer
juliensf at cs.mu.OZ.AU
Tue Apr 19 09:05:54 AEST 2005
Estimated hours taken: 1.5
Branches: main
Clean up lp.m and bring it more into sync with the corresponding
parts of lp_rational.m. The one algorithmic change s to replace
two closures that where called by an all solutions predicate with a
single iterative predicate that does the same thing.
Shift lp.m from the transform_hlds package into the libs package.
compiler/lp.m:
Shift to 4-space indentation throughout.
Use state variables throughout and rearrange argument
orders where necessary.
Use predmode syntax throughout.
Add field names to several of the major data structures
in this module.
Standardize variable names.
s/__/./ throughout.
Other minor formatting changes.
compiler/transform_hlds.m:
compiler/libs.m:
Move the lp module from the transform_hlds package to the
libs package. It doesn't really have anything to do with
the HLDS.
compiler/term_pass1.m:
compiler/notes/compiler_design.html:
Minor changes to conform to the above.
Julien.
Index: compiler/libs.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/libs.m,v
retrieving revision 1.4
diff -u -r1.4 libs.m
--- compiler/libs.m 7 Apr 2005 06:32:08 -0000 1.4
+++ compiler/libs.m 18 Apr 2005 06:43:24 -0000
@@ -26,7 +26,8 @@
:- include_module process_util.
:- include_module timestamp.
-% Constraint machinery for the termination analyser.
+% Constraint machinery for the termination analysers.
+:- include_module lp.
:- include_module lp_rational.
:- include_module polyhedron.
:- include_module rat.
Index: compiler/lp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lp.m,v
retrieving revision 1.10
diff -u -r1.10 lp.m
--- compiler/lp.m 22 Mar 2005 06:40:05 -0000 1.10
+++ compiler/lp.m 18 Apr 2005 06:45:08 -0000
@@ -1,38 +1,39 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1997,2002-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% file: lp.m
-% main author: conway, Oct 1997
+% main author: conway, Oct 1997
%
% This module implements a linear constraint solver that finds an
% optimal solution to a set of linear [in]equalities with respect
% to some objective function. It does this using the simplex method.
%
% The form of an [in]equation is
-% a1.x1 + a2.x2 + ... + an.xn {=<,=,>=} b
+% a1.x1 + a2.x2 + ... + an.xn {=<,=,>=} b
% where all the numbers are floats, a variable xn may occur multiple
% times in an equation (or the objective function) - the solver simplifies
% all the inequations.
% By default, there is an additional constraint on each of the `xn's:
-% xn >= 0
+% xn >= 0
% If you want xn to take on any value, you can include it in the list
% of URS (UnRestricted in Sign) variables.
%
% The objective function is simply a weighted sum of the variables.
%
-% The `x's are represented by `term__var's. The varset from which
+% The `x's are represented by `term.var's. The varset from which
% they are allocated is passed to the solver because it needs to
% introduce new variables as part of the solving algorithm.
%
%------------------------------------------------------------------------------%
-:- module transform_hlds__lp.
-:- interface.
+:- module libs.lp.
-%------------------------------------------------------------------------------%
+:- interface.
:- import_module float.
:- import_module io.
@@ -42,44 +43,39 @@
:- import_module term.
:- import_module varset.
-:- type coeff == pair(var, float).
+:- type coeff == pair(var, float).
-:- type equation
- ---> eqn(list(coeff), operator, float).
+:- type equation ---> eqn(list(coeff), operator, float).
-:- type operator
- ---> (=<) ; (=) ; (>=) .
+:- type operator ---> (=<) ; (=) ; (>=).
-:- type equations == list(equation).
+:- type equations == list(equation).
-:- type objective == list(coeff).
+:- type objective == list(coeff).
-:- type direction
- ---> max ; min .
+:- type direction ---> max ; min.
-:- type lp__result
- ---> unsatisfiable
- ; satisfiable(float, map(var, float))
- .
+:- type lp.result
+ ---> unsatisfiable
+ ; satisfiable(float, map(var, float)).
%------------------------------------------------------------------------------%
- % lp_solve(Inequations, MaxOrMin, Objective, Varset, URSVars,
- % Result, IO0, IO)
- % maximize (or minimize - depending on `MaxOrMin') `Objective'
- % subject to the constraints `Inequations'. The variables in
- % the objective and inequations are from `Varset' which is passed
- % so that the solver can allocate fresh variables as required.
- % URSVars is the list of variable that are unrestricted in sign.
- % lp_solve binds Result either to `unsatisfiable' if the there
- % was no optimum value of the objective function (ie the
- % constraints were inconsistent, or the objective function
- % is unbounded by the constraints), or `satisfiable(ObjVal,
- % MapFromObjVarsToVals)'.
-
-:- pred lp_solve(equations, direction, objective, varset, list(var),
- lp__result, io__state, io__state).
-:- mode lp_solve(in, in, in, in, in, out, di, uo) is det.
+ % lp_solve(Inequations, MaxOrMin, Objective, Varset, URSVars,
+ % Result, IO0, IO)
+ % maximize (or minimize - depending on `MaxOrMin') `Objective'
+ % subject to the constraints `Inequations'. The variables in
+ % the objective and inequations are from `Varset' which is passed
+ % so that the solver can allocate fresh variables as required.
+ % URSVars is the list of variable that are unrestricted in sign.
+ % lp_solve binds Result either to `unsatisfiable' if the there
+ % was no optimum value of the objective function (ie the
+ % constraints were inconsistent, or the objective function
+ % is unbounded by the constraints), or `satisfiable(ObjVal,
+ % MapFromObjVarsToVals)'.
+ %
+:- pred lp_solve(equations::in, direction::in, objective::in, varset::in,
+ list(var)::in, lp.result::out, io::di, io::uo) is det.
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
@@ -91,864 +87,848 @@
:- import_module require.
:- import_module set.
:- import_module string.
+:- import_module svmap.
+:- import_module svset.
+:- import_module svvarset.
-:- type lp_info --->
- lp(
- varset,
- map(var, pair(var)), % map from variables with URS to
- % the corresponding pair of variables
- % that represent that variable in
- % the standard form (x = x' - x'',
- % x', x'' >= 0).
- list(var), % slack variables
- list(var) % artificial variables
- ).
-
-lp_solve(Eqns, Dir, Obj, Varset0, URSVars, Result, IO0, IO) :-
- lp_info_init(Varset0, URSVars, Info0),
- lp_solve2(Eqns, Dir, Obj, Result, IO0, IO, Info0, _).
+%------------------------------------------------------------------------------%
-%
-% lp_solve2(Eqns, Dir, Obj, Res, IO0, IO, LPInfo0, LPInfo) takes a list
-% of inequations `Eqns', a direction for optimization `Dir', an objective
-% function `Obj', an I/O state `IO0' and an lp_info structure `LPInfo0'.
-% See inline comments for details on the algorithm.
-%
-:- pred lp_solve2(equations, direction, objective, lp__result,
- io__state, io__state, lp_info, lp_info).
-:- mode lp_solve2(in, in, in, out, di, uo, in, out) is det.
-
-lp_solve2(Eqns0, Dir, Obj0, Result, IO0, IO, Info0, Info) :-
- % simplify the inequations and convert them
- % to standard form by introducing slack/excess/
- % artificial variables. We also expand URS variables
- % by replacing them with the difference of two
- % fresh variables.
- standardize_equations(Eqns0, Eqns, Info0, Info1),
-
- % If we're maximizing the objective function then we need
- % to negate all the coefficients in the objective.w
- (
- Dir = max,
- negate_equation(eqn(Obj0, (=), 0.0), eqn(Obj1, _, _))
- ;
- Dir = min,
- Obj1 = Obj0
- ),
- simplify_coeffs(Obj1, Obj2),
-
- get_urs_vars(URS, Info1, _),
- expand_urs_vars(Obj2, URS, Obj),
- list__length(Eqns, Rows),
- collect_vars(Eqns, Obj, Vars),
- set__to_sorted_list(Vars, VarList),
- list__length(VarList, Cols),
- map__init(VarNums0),
- number_vars(VarList, 0, VarNums0, VarNums),
- get_art_vars(ArtVars, Info1, Info),
- init_tableau(Rows, Cols, VarNums, URS, Tableau0),
- insert_equations(Eqns, 1, Cols, VarNums,
- Tableau0, Tableau1),
- (
- ArtVars = [_|_],
- % There are one or more artificial variables, so we use
- % the two-phase method for solving the system.
- two_phase(Obj0, Obj, ArtVars, VarNums, Tableau1, Result0,
- IO0, IO)
- ;
- ArtVars = [],
- one_phase(Obj0, Obj, VarNums, Tableau1, Result0, IO0, IO)
- ),
- (
- Dir = max,
- Result = Result0
- ;
- Dir = min,
- (
- Result0 = unsatisfiable,
- Result = Result0
- ;
- Result0 = satisfiable(NOptVal, OptCoffs),
- OptVal = -NOptVal,
- Result = satisfiable(OptVal, OptCoffs)
- )
- ).
-
-%------------------------------------------------------------------------------%
-
-:- pred one_phase(list(coeff), list(coeff), map(var, int), tableau,
- lp__result, io__state, io__state).
-:- mode one_phase(in, in, in, in, out, di, uo) is det.
-
-one_phase(Obj0, Obj, VarNums, Tableau0, Result, IO0, IO) :-
- insert_coeffs(Obj, 0, VarNums, Tableau0, Tableau1),
- GetObjVar = (pred(V::out) is nondet :-
- list__member(X, Obj0),
- X = V - _Cof
- ),
- solutions(GetObjVar, ObjVars),
- optimize(ObjVars, Tableau1, _, Result, IO0, IO).
-
-%------------------------------------------------------------------------------%
-
-:- pred two_phase(list(coeff), list(coeff), list(var), map(var, int),
- tableau, lp__result, io__state, io__state).
-:- mode two_phase(in, in, in, in, in, out, di, uo) is det.
-
-two_phase(Obj0, Obj, ArtVars, VarNums, Tableau0, Result, IO0, IO) :-
- % Do phase 1:
- % minimize the sum of the artificial variables
- construct_art_objective(ArtVars, ArtObj),
- insert_coeffs(ArtObj, 0, VarNums, Tableau0, Tableau1a),
- ensure_zero_obj_coeffs(ArtVars, Tableau1a, Tableau1b),
- optimize(ArtVars, Tableau1b, Tableau1c,
- Res0, IO0, IO1),
- (
- Res0 = unsatisfiable,
- Result = unsatisfiable,
- IO = IO1
- ;
- Res0 = satisfiable(Val, _ArtRes),
- ( Val \= 0.0 ->
- Result = unsatisfiable,
- IO = IO1
- ;
- fix_basis_and_rem_cols(ArtVars, Tableau1c, Tableau2),
- % Do phase 2:
- % insert the real objective,
- % zero the objective coefficients of the
- % basis variables,
- % optimize the objective.
- insert_coeffs(Obj, 0, VarNums, Tableau2, Tableau3),
- get_basis_vars(Tableau3, BasisVars),
- ensure_zero_obj_coeffs(BasisVars,
- Tableau3, Tableau4),
- GetObjVar = (pred(V::out) is nondet :-
- list__member(X, Obj0),
- X = V - _Cof
- ),
- solutions(GetObjVar, ObjVars),
- optimize(ObjVars, Tableau4, _, Result, IO1, IO)
- )
- ).
+:- type lp_info --->
+ lp(
+ varset :: varset,
+ urs_map :: map(var, pair(var)),
+ % Map from variables with URS to the
+ % corresponding pair of variables that
+ % represent that variable in the standard
+ % form (x = x' - x'', x', x'' >= 0).
+
+ slack_vars :: list(var), % slack variables
+
+ artificial_vars :: list(var) % artificial variables
+ ).
+
+%------------------------------------------------------------------------------%
+
+lp_solve(Eqns, Dir, Obj, Varset0, URSVars, Result, !IO) :-
+ lp_info_init(Varset0, URSVars, Info0),
+ lp_solve_2(Eqns, Dir, Obj, Result, Info0, _, !IO).
+
+ % lp_solve2(Eqns, Dir, Obj, Res, IO0, IO, LPInfo0, LPInfo) takes
+ % a list of inequations `Eqns', a direction for optimization
+ % `Dir', an objective function `Obj', an I/O state `IO0' and an
+ % lp_info structure `LPInfo0'. See inline comments for details
+ % on the algorithm.
+ %
+:- pred lp_solve_2(equations::in, direction::in, objective::in,
+ lp.result::out, lp_info::in, lp_info::out, io::di, io::uo)
+ is det.
+
+lp_solve_2(Eqns0, Dir, Obj0, Result, !Info, !IO) :-
+ %
+ % Simplify the inequations and convert them to standard form by
+ % introducing slack/excess/artificial variables. We also expand
+ % URS variables by replacing them with the difference of two
+ % fresh variables.
+ %
+ standardize_equations(Eqns0, Eqns, !Info),
+ %
+ % If we're maximizing the objective function then we need
+ % to negate all the coefficients in the objective.
+ %
+ (
+ Dir = max,
+ negate_equation(eqn(Obj0, (=), 0.0), eqn(Obj1, _, _))
+ ;
+ Dir = min,
+ Obj1 = Obj0
+ ),
+ simplify_coeffs(Obj1, Obj2),
+
+ get_urs_vars(URS, !.Info, _),
+ expand_urs_vars(Obj2, URS, Obj),
+ list.length(Eqns, Rows),
+ collect_vars(Eqns, Obj, Vars),
+ set.to_sorted_list(Vars, VarList),
+ list.length(VarList, Cols),
+ map.init(VarNums0),
+ number_vars(VarList, 0, VarNums0, VarNums),
+ get_art_vars(ArtVars, !Info),
+ some [!Tableau] (
+ init_tableau(Rows, Cols, VarNums, URS, !:Tableau),
+ insert_equations(Eqns, 1, Cols, VarNums, !Tableau),
+ (
+ ArtVars = [_|_],
+ % There are one or more artificial variables, so we use
+ % the two-phase method for solving the system.
+ two_phase(Obj0, Obj, ArtVars, VarNums, !.Tableau, Result0)
+ ;
+ ArtVars = [],
+ one_phase(Obj0, Obj, VarNums, !.Tableau, Result0)
+ )
+ ),
+ (
+ Dir = max,
+ Result = Result0
+ ;
+ Dir = min,
+ (
+ Result0 = unsatisfiable,
+ Result = Result0
+ ;
+ Result0 = satisfiable(NOptVal, OptCoffs),
+ OptVal = -NOptVal,
+ Result = satisfiable(OptVal, OptCoffs)
+ )
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred one_phase(list(coeff)::in, list(coeff)::in, map(var, int)::in,
+ tableau::in, lp.result::out) is det.
+
+one_phase(Obj0, Obj, VarNums, Tableau0, Result) :-
+ insert_coeffs(Obj, 0, VarNums, Tableau0, Tableau1),
+ ObjVars = get_vars_from_coeffs(Obj0),
+ optimize(ObjVars, Tableau1, _, Result).
+
+:- func get_vars_from_coeffs(list(coeff)) = list(var).
+
+get_vars_from_coeffs(Coeffs) = Vars :-
+ get_vars_from_coeffs_2(Coeffs, set.init, SetVars),
+ Vars = set.to_sorted_list(SetVars).
+
+:- pred get_vars_from_coeffs_2(list(coeff)::in, set(var)::in, set(var)::out)
+ is det.
+
+get_vars_from_coeffs_2([], !SetVar).
+get_vars_from_coeffs_2([Var - _ | Coeffs], !SetVar) :-
+ svset.insert(Var, !SetVar),
+ get_vars_from_coeffs_2(Coeffs, !SetVar).
+
+%------------------------------------------------------------------------------%
+
+:- pred two_phase(list(coeff)::in, list(coeff)::in, list(var)::in,
+ map(var, int)::in, tableau::in, lp.result::out) is det.
+
+two_phase(Obj0, Obj, ArtVars, VarNums, Tableau0, Result) :-
+ %
+ % Do phase 1: minimize the sum of the artificial variables.
+ %
+ some [!Tableau] (
+ !:Tableau = Tableau0,
+ construct_art_objective(ArtVars, ArtObj),
+ insert_coeffs(ArtObj, 0, VarNums, !Tableau),
+ ensure_zero_obj_coeffs(ArtVars, !Tableau),
+ optimize(ArtVars, !Tableau, Res0),
+ (
+ Res0 = unsatisfiable,
+ Result = unsatisfiable
+ ;
+ Res0 = satisfiable(Val, _ArtRes),
+ ( Val \= 0.0 ->
+ Result = unsatisfiable
+ ;
+ fix_basis_and_rem_cols(ArtVars, !Tableau),
+ % Do phase 2:
+ % insert the real objective,
+ % zero the objective coefficients of the
+ % basis variables,
+ % optimize the objective.
+ insert_coeffs(Obj, 0, VarNums, !Tableau),
+ get_basis_vars(!.Tableau, BasisVars),
+ ensure_zero_obj_coeffs(BasisVars, !Tableau),
+ ObjVars = get_vars_from_coeffs(Obj0),
+ optimize(ObjVars, !.Tableau, _, Result)
+ )
+ )
+ ).
%------------------------------------------------------------------------------%
-:- pred construct_art_objective(list(var), list(coeff)).
-:- mode construct_art_objective(in, out) is det.
+:- pred construct_art_objective(list(var)::in, list(coeff)::out) is det.
construct_art_objective([], []).
-construct_art_objective([V|Vs], [V - (1.0)|Rest]) :-
- construct_art_objective(Vs, Rest).
+construct_art_objective([V | Vs], [V - (1.0) | Rest]) :-
+ construct_art_objective(Vs, Rest).
%------------------------------------------------------------------------------%
-:- pred standardize_equations(equations, equations, lp_info, lp_info).
-:- mode standardize_equations(in, out, in, out) is det.
+:- pred standardize_equations(equations::in, equations::out,
+ lp_info::in, lp_info::out) is det.
-standardize_equations(Eqns0, Eqns) -->
- list__map_foldl(standardize_equation, Eqns0, Eqns).
-
- % standardize_equation peforms the following operations on an
- % equation:
- % - ensures the constant is >= 0 (multiplying by -1 if
- % necessary)
- % - introduces slack, excess and artificial variables
- % - replace the URS variables with their corresponding
- % difference pair
-:- pred standardize_equation(equation, equation, lp_info, lp_info).
-:- mode standardize_equation(in, out, in, out) is det.
-
-standardize_equation(Eqn0, Eqn) -->
- { Eqn0 = eqn(Coeffs0, (=<), Const0) },
- ( { Const0 < 0.0 } ->
- { negate_equation(Eqn0, Eqn1) },
- standardize_equation(Eqn1, Eqn)
- ;
- new_slack_var(Var),
- { Coeffs = [Var - 1.0|Coeffs0] },
- { simplify(eqn(Coeffs, (=<), Const0), Eqn1) },
- get_urs_vars(URS),
- { expand_urs_vars_e(Eqn1, URS, Eqn) }
- ).
-
-standardize_equation(Eqn0, Eqn) -->
- { Eqn0 = eqn(Coeffs0, (=), Const0) },
- ( { Const0 < 0.0 } ->
- { negate_equation(Eqn0, Eqn1) },
- standardize_equation(Eqn1, Eqn)
- ;
- new_art_var(Var),
- { Coeffs = [Var - 1.0|Coeffs0] },
- { simplify(eqn(Coeffs, (=<), Const0), Eqn1) },
- get_urs_vars(URS),
- { expand_urs_vars_e(Eqn1, URS, Eqn) }
- ).
-
-standardize_equation(Eqn0, Eqn) -->
- { Eqn0 = eqn(Coeffs0, (>=), Const0) },
- ( { Const0 < 0.0 } ->
- { negate_equation(Eqn0, Eqn1) },
- standardize_equation(Eqn1, Eqn)
- ;
- new_slack_var(SVar),
- new_art_var(AVar),
- { Coeffs = [SVar - (-1.0), AVar - (1.0)|Coeffs0] },
- { simplify(eqn(Coeffs, (>=), Const0), Eqn1) },
- get_urs_vars(URS),
- { expand_urs_vars_e(Eqn1, URS, Eqn) }
- ).
+standardize_equations(!Eqns, !Info) :-
+ list.map_foldl(standardize_equation, !Eqns, !Info).
+
+ % standardize_equation peforms the following operations on an
+ % equation:
+ % - ensures the constant is >= 0 (multiplying by -1 if
+ % necessary)
+ % - introduces slack, excess and artificial variables
+ % - replace the URS variables with their corresponding
+ % difference pair
+ %
+:- pred standardize_equation(equation::in, equation::out,
+ lp_info::in, lp_info::out) is det.
+
+standardize_equation(Eqn0, Eqn, !Info) :-
+ Eqn0 = eqn(Coeffs0, (=<), Const0),
+ ( Const0 < 0.0 ->
+ negate_equation(Eqn0, Eqn1),
+ standardize_equation(Eqn1, Eqn, !Info)
+ ;
+ new_slack_var(Var, !Info),
+ Coeffs = [Var - 1.0 | Coeffs0],
+ simplify(eqn(Coeffs, (=<), Const0), Eqn1),
+ get_urs_vars(URS, !Info),
+ expand_urs_vars_e(Eqn1, URS, Eqn)
+ ).
+
+standardize_equation(Eqn0, Eqn, !Info) :-
+ Eqn0 = eqn(Coeffs0, (=), Const0),
+ ( Const0 < 0.0 ->
+ negate_equation(Eqn0, Eqn1),
+ standardize_equation(Eqn1, Eqn, !Info)
+ ;
+ new_art_var(Var, !Info),
+ Coeffs = [Var - 1.0 | Coeffs0],
+ simplify(eqn(Coeffs, (=<), Const0), Eqn1),
+ get_urs_vars(URS, !Info),
+ expand_urs_vars_e(Eqn1, URS, Eqn)
+ ).
+
+standardize_equation(Eqn0, Eqn, !Info) :-
+ Eqn0 = eqn(Coeffs0, (>=), Const0),
+ ( Const0 < 0.0 ->
+ negate_equation(Eqn0, Eqn1),
+ standardize_equation(Eqn1, Eqn, !Info)
+ ;
+ new_slack_var(SVar, !Info),
+ new_art_var(AVar, !Info),
+ Coeffs = [SVar - (-1.0), AVar - (1.0) | Coeffs0],
+ simplify(eqn(Coeffs, (>=), Const0), Eqn1),
+ get_urs_vars(URS, !Info),
+ expand_urs_vars_e(Eqn1, URS, Eqn)
+ ).
-:- pred negate_equation(equation, equation).
-:- mode negate_equation(in, out) is det.
+:- pred negate_equation(equation::in, equation::out) is det.
negate_equation(eqn(Coeffs0, Op0, Const0), eqn(Coeffs, Op, Const)) :-
- (
- Op0 = (=<), Op = (>=)
- ;
- Op0 = (=), Op = (=)
- ;
- Op0 = (>=), Op = (=<)
- ),
- Coeffs = list__map((func(V - X) = V - (-X)), Coeffs0),
- Const = -Const0.
+ (
+ Op0 = (=<), Op = (>=)
+ ;
+ Op0 = (=), Op = (=)
+ ;
+ Op0 = (>=), Op = (=<)
+ ),
+ Coeffs = list.map((func(V - X) = V - (-X)), Coeffs0),
+ Const = -Const0.
-:- pred simplify(equation, equation).
-:- mode simplify(in, out) is det.
+:- pred simplify(equation::in, equation::out) is det.
simplify(eqn(Coeffs0, Op, Const), eqn(Coeffs, Op, Const)) :-
- simplify_coeffs(Coeffs0, Coeffs).
+ simplify_coeffs(Coeffs0, Coeffs).
-:- pred simplify_coeffs(list(coeff), list(coeff)).
-:- mode simplify_coeffs(in, out) is det.
+:- pred simplify_coeffs(list(coeff)::in, list(coeff)::out) is det.
simplify_coeffs(Coeffs0, Coeffs) :-
- map__init(CoeffMap0),
- AddCoeff = (pred(Pair::in, Map0::in, Map::out) is det :-
- Pair = Var - Coeff,
- add_var(Map0, Var, Coeff, Map)
- ),
- list__foldl(AddCoeff, Coeffs0, CoeffMap0, CoeffMap),
- map__to_assoc_list(CoeffMap, Coeffs).
-
-:- pred add_var(map(var, float), var, float, map(var, float)).
-:- mode add_var(in, in, in, out) is det.
-
-add_var(Map0, Var, Coeff, Map) :-
- ( map__search(Map0, Var, Acc0) ->
- Acc1 = Acc0
- ;
- Acc1 = 0.0
- ),
- Acc = Acc1 + Coeff,
- map__set(Map0, Var, Acc, Map).
+ map.init(CoeffMap0),
+ AddCoeff = (pred(Pair::in, Map0::in, Map::out) is det :-
+ Pair = Var - Coeff,
+ add_var(Var, Coeff, Map0, Map)
+ ),
+ list.foldl(AddCoeff, Coeffs0, CoeffMap0, CoeffMap),
+ map.to_assoc_list(CoeffMap, Coeffs).
+
+:- pred add_var(var::in, float::in,
+ map(var, float)::in, map(var, float)::out) is det.
+
+add_var(Var, Coeff, !Map) :-
+ ( map.search(!.Map, Var, Acc0) ->
+ Acc1 = Acc0
+ ;
+ Acc1 = 0.0
+ ),
+ Acc = Acc1 + Coeff,
+ svmap.set(Var, Acc, !Map).
-:- pred expand_urs_vars_e(equation, map(var, pair(var)), equation).
-:- mode expand_urs_vars_e(in, in, out) is det.
+:- pred expand_urs_vars_e(equation::in, map(var, pair(var))::in,
+ equation::out) is det.
expand_urs_vars_e(eqn(Coeffs0, Op, Const), Vars, eqn(Coeffs, Op, Const)) :-
- expand_urs_vars(Coeffs0, Vars, Coeffs).
+ expand_urs_vars(Coeffs0, Vars, Coeffs).
-:- pred expand_urs_vars(list(coeff), map(var, pair(var)), list(coeff)).
-:- mode expand_urs_vars(in, in, out) is det.
+:- pred expand_urs_vars(list(coeff)::in, map(var, pair(var))::in,
+ list(coeff)::out) is det.
expand_urs_vars(Coeffs0, Vars, Coeffs) :-
- expand_urs_vars(Coeffs0, Vars, [], Coeffs1),
- list__reverse(Coeffs1, Coeffs).
+ expand_urs_vars(Coeffs0, Vars, [], Coeffs1),
+ list.reverse(Coeffs1, Coeffs).
+
+:- pred expand_urs_vars(list(coeff)::in, map(var, pair(var))::in,
+ list(coeff)::in, list(coeff)::out) is det.
-:- pred expand_urs_vars(list(coeff), map(var, pair(var)),
- list(coeff), list(coeff)).
-:- mode expand_urs_vars(in, in, in, out) is det.
-
-expand_urs_vars([], _Vars, Coeffs, Coeffs).
-expand_urs_vars([Var - Coeff|Rest], Vars, Coeffs0, Coeffs) :-
- ( map__search(Vars, Var, PVar - NVar) ->
- NCoeff = -Coeff,
- Coeffs1 = [NVar - NCoeff, PVar - Coeff|Coeffs0]
- ;
- Coeffs1 = [Var - Coeff|Coeffs0]
- ),
- expand_urs_vars(Rest, Vars, Coeffs1, Coeffs).
+expand_urs_vars([], _Vars, !Coeffs).
+expand_urs_vars([Var - Coeff | Rest], Vars, !Coeffs) :-
+ ( map.search(Vars, Var, PVar - NVar) ->
+ NCoeff = -Coeff,
+ !:Coeffs = [NVar - NCoeff, PVar - Coeff | !.Coeffs]
+ ;
+ !:Coeffs = [Var - Coeff | !.Coeffs]
+ ),
+ expand_urs_vars(Rest, Vars, !Coeffs).
%------------------------------------------------------------------------------%
-:- pred collect_vars(equations, objective, set(var)).
-:- mode collect_vars(in, in, out) is det.
+:- pred collect_vars(equations::in, objective::in, set(var)::out) is det.
collect_vars(Eqns, Obj, Vars) :-
- GetVar = (pred(Var::out) is nondet :-
- (
- list__member(Eqn, Eqns),
- Eqn = eqn(Coeffs, _, _),
- list__member(Pair, Coeffs),
- Pair = Var - _
- ;
- list__member(Pair, Obj),
- Pair = Var - _
- )
- ),
- solutions(GetVar, VarList),
- set__list_to_set(VarList, Vars).
-
-:- pred number_vars(list(var), int, map(var, int), map(var, int)).
-:- mode number_vars(in, in, in, out) is det.
-
-number_vars([], _, VarNums, VarNums).
-number_vars([Var|Vars], N, VarNums0, VarNums) :-
- map__det_insert(VarNums0, Var, N, VarNums1),
- N1 = N + 1,
- number_vars(Vars, N1, VarNums1, VarNums).
-
-:- pred insert_equations(equations, int, int, map(var, int), tableau, tableau).
-:- mode insert_equations(in, in, in, in, in, out) is det.
-
-insert_equations([], _, _, _, Tableau, Tableau).
-insert_equations([Eqn|Eqns], Row, ConstCol, VarNums, Tableau0, Tableau) :-
- Eqn = eqn(Coeffs, _Op, Const),
- insert_coeffs(Coeffs, Row, VarNums, Tableau0, Tableau1),
- set_index(Tableau1, Row, ConstCol, Const, Tableau2),
- Row1 = Row + 1,
- insert_equations(Eqns, Row1, ConstCol, VarNums, Tableau2, Tableau).
-
-:- pred insert_coeffs(list(coeff), int, map(var, int), tableau, tableau).
-:- mode insert_coeffs(in, in, in, in, out) is det.
-
-insert_coeffs([], _Row, _VarNums, Tableau, Tableau).
-insert_coeffs([Coeff|Coeffs], Row, VarNums, Tableau0, Tableau) :-
- Coeff = Var - Const,
- map__lookup(VarNums, Var, Col),
- set_index(Tableau0, Row, Col, Const, Tableau1),
- insert_coeffs(Coeffs, Row, VarNums, Tableau1, Tableau).
-
-%------------------------------------------------------------------------------%
-
-:- pred optimize(list(var), tableau, tableau, lp__result,
- io__state, io__state).
-:- mode optimize(in, in, out, out, di, uo) is det.
-
-optimize(ObjVars, A0, A, Result) -->
- simplex(A0, A, Res0),
- (
- { Res0 = no },
- { Result = unsatisfiable }
- ;
- { Res0 = yes },
- { rhs_col(A, M) },
- { index(A, 0, M, ObjVal) },
- { extract_objective(ObjVars, A, ObjMap) },
- { Result = satisfiable(ObjVal, ObjMap) }
- ).
+ GetVar = (pred(Var::out) is nondet :-
+ (
+ list.member(Eqn, Eqns),
+ Eqn = eqn(Coeffs, _, _),
+ list.member(Pair, Coeffs),
+ Pair = Var - _
+ ;
+ list.member(Pair, Obj),
+ Pair = Var - _
+ )
+ ),
+ solutions(GetVar, VarList),
+ set.list_to_set(VarList, Vars).
+
+:- pred number_vars(list(var)::in, int::in,
+ map(var, int)::in, map(var, int)::out) is det.
+
+number_vars([], _, !VarNums).
+number_vars([Var | Vars], N, !VarNums) :-
+ svmap.det_insert(Var, N, !VarNums),
+ number_vars(Vars, N + 1, !VarNums).
+
+:- pred insert_equations(equations::in, int::in, int::in, map(var, int)::in,
+ tableau::in, tableau::out) is det.
+
+insert_equations([], _, _, _, !Tableau).
+insert_equations([Eqn | Eqns], Row, ConstCol, VarNums, !Tableau) :-
+ Eqn = eqn(Coeffs, _Op, Const),
+ insert_coeffs(Coeffs, Row, VarNums, !Tableau),
+ set_index(Row, ConstCol, Const, !Tableau),
+ insert_equations(Eqns, Row + 1, ConstCol, VarNums, !Tableau).
+
+:- pred insert_coeffs(list(coeff)::in, int::in, map(var, int)::in,
+ tableau::in, tableau::out) is det.
+
+insert_coeffs([], _Row, _VarNums, !Tableau).
+insert_coeffs([Coeff|Coeffs], Row, VarNums, !Tableau) :-
+ Coeff = Var - Const,
+ map.lookup(VarNums, Var, Col),
+ set_index(Row, Col, Const, !Tableau),
+ insert_coeffs(Coeffs, Row, VarNums, !Tableau).
+
+%------------------------------------------------------------------------------%
+
+:- pred optimize(list(var)::in, tableau::in, tableau::out, lp.result::out)
+ is det.
+
+optimize(ObjVars, A0, A, Result) :-
+ simplex(A0, A, Res0),
+ (
+ Res0 = no,
+ Result = unsatisfiable
+ ;
+ Res0 = yes,
+ rhs_col(A, M),
+ index(A, 0, M, ObjVal),
+ extract_objective(ObjVars, A, ObjMap),
+ Result = satisfiable(ObjVal, ObjMap)
+ ).
-:- pred extract_objective(list(var), tableau, map(var, float)).
-:- mode extract_objective(in, in, out) is det.
+:- pred extract_objective(list(var)::in, tableau::in,
+ map(var, float)::out) is det.
extract_objective(ObjVars, Tab, Res) :-
- map__init(Res0),
- list__foldl(extract_obj_var(Tab), ObjVars, Res0, Res).
+ list.foldl(extract_obj_var(Tab), ObjVars, map.init, Res).
-:- pred extract_obj_var(tableau, var, map(var, float), map(var, float)).
-:- mode extract_obj_var(in, in, in, out) is det.
+:- pred extract_obj_var(tableau::in, var::in,
+ map(var, float)::in, map(var, float)::out) is det.
-extract_obj_var(Tab, Var, Map0, Map) :-
- urs_vars(Tab, Vars),
- ( map__search(Vars, Var, Pos - Neg) ->
- extract_obj_var2(Tab, Pos, PosVal),
- extract_obj_var2(Tab, Neg, NegVal),
- Val = PosVal - NegVal
- ;
- extract_obj_var2(Tab, Var, Val)
- ),
- map__set(Map0, Var, Val, Map).
+extract_obj_var(Tab, Var, !Map) :-
+ urs_vars(Tab, Vars),
+ ( map.search(Vars, Var, Pos - Neg) ->
+ extract_obj_var2(Tab, Pos, PosVal),
+ extract_obj_var2(Tab, Neg, NegVal),
+ Val = PosVal - NegVal
+ ;
+ extract_obj_var2(Tab, Var, Val)
+ ),
+ svmap.set(Var, Val, !Map).
-:- pred extract_obj_var2(tableau, var, float).
-:- mode extract_obj_var2(in, in, out) is det.
+:- pred extract_obj_var2(tableau::in, var::in, float::out) is det.
extract_obj_var2(Tab, Var, Val) :-
- var_col(Tab, Var, Col),
- GetCell = (pred(Val0::out) is nondet :-
- all_rows(Tab, Row),
- index(Tab, Row, Col, 1.0),
- rhs_col(Tab, RHS),
- index(Tab, Row, RHS, Val0)
- ),
- solutions(GetCell, Solns),
- ( Solns = [Val1] ->
- Val = Val1
- ;
- Val = 0.0
- ).
-
-:- pred simplex(tableau, tableau, bool, io__state, io__state).
-:- mode simplex(in, out, out, di, uo) is det.
-
-simplex(A0, A, Result, IO0, IO) :-
- AllColumns = all_cols(A0),
- MinAgg = (pred(Col::in, Min0::in, Min::out) is det :-
- (
- Min0 = no,
- index(A0, 0, Col, MinVal),
- ( MinVal < 0.0 ->
- Min = yes(Col - MinVal)
- ;
- Min = no
- )
- ;
- Min0 = yes(_ - MinVal0),
- index(A0, 0, Col, CellVal),
- ( CellVal < MinVal0 ->
- Min = yes(Col - CellVal)
- ;
- Min = Min0
- )
- )
- ),
- aggregate(AllColumns, MinAgg, no, MinResult),
- (
- MinResult = no,
- A = A0,
- IO = IO0,
- Result = yes
- ;
- MinResult = yes(Q - _Val),
- AllRows = all_rows(A0),
- MaxAgg = (pred(Row::in, Max0::in, Max::out) is det :-
- (
- Max0 = no,
- index(A0, Row, Q, MaxVal),
- ( MaxVal > 0.0 ->
- rhs_col(A0, RHSC),
- index(A0, Row, RHSC, MVal),
- CVal = MVal/MaxVal,
- Max = yes(Row - CVal)
- ;
- Max = no
- )
- ;
- Max0 = yes(_ - MaxVal0),
- index(A0, Row, Q, CellVal),
- rhs_col(A0, RHSC),
- index(A0, Row, RHSC, MVal),
- (
- CellVal > 0.0,
- MaxVal1 = MVal/CellVal,
- MaxVal1 =< MaxVal0
- ->
- Max = yes(Row - MaxVal1)
- ;
- Max = Max0
- )
- )
- ),
- aggregate(AllRows, MaxAgg, no, MaxResult),
- (
- MaxResult = no,
- A = A0,
- IO = IO0,
- Result = no
- ;
- MaxResult = yes(P - _),
- pivot(P, Q, A0, A1),
- simplex(A1, A, Result, IO0, IO)
- )
- ).
-
-%------------------------------------------------------------------------------%
-
-:- pred ensure_zero_obj_coeffs(list(var), tableau, tableau).
-:- mode ensure_zero_obj_coeffs(in, in, out) is det.
-
-ensure_zero_obj_coeffs([], Tableau, Tableau).
-ensure_zero_obj_coeffs([V|Vs], Tableau0, Tableau) :-
- var_col(Tableau0, V, Col),
- index(Tableau0, 0, Col, Val),
- ( Val = 0.0 ->
- ensure_zero_obj_coeffs(Vs, Tableau0, Tableau)
- ;
- FindOne = (pred(P::out) is nondet :-
- all_rows(Tableau0, R),
- index(Tableau0, R, Col, ValF0),
- ValF0 \= 0.0,
- P = R - ValF0
- ),
- solutions(FindOne, Ones),
- (
- Ones = [Row - Fac0|_],
- Fac = -Val/Fac0,
- row_op(Fac, Row, 0, Tableau0, Tableau1),
- ensure_zero_obj_coeffs(Vs, Tableau1, Tableau)
- ;
- Ones = [],
- error("problem with artificial variable")
- )
- ).
-
-:- pred fix_basis_and_rem_cols(list(var), tableau, tableau).
-:- mode fix_basis_and_rem_cols(in, in, out) is det.
-
-fix_basis_and_rem_cols([], Tab, Tab).
-fix_basis_and_rem_cols([V|Vs], Tab0, Tab) :-
- var_col(Tab0, V, Col),
- BasisAgg = (pred(R::in, Ones0::in, Ones::out) is det :-
- index(Tab0, R, Col, Val),
- ( Val = 0.0 ->
- Ones = Ones0
- ;
- Ones = [Val - R|Ones0]
- )
- ),
- aggregate(all_rows(Tab0), BasisAgg, [], Res),
- (
- Res = [1.0 - Row]
- ->
- PivGoal = (pred(Col1::out) is nondet :-
- all_cols(Tab0, Col1),
- Col \= Col1,
- index(Tab0, Row, Col1, Zz),
- Zz \= 0.0
- ),
- solutions(PivGoal, PivSolns),
- (
- PivSolns = [],
- remove_col(Col, Tab0, Tab0a),
- remove_row(Row, Tab0a, Tab1)
- ;
- PivSolns = [Col2|_],
- pivot(Row, Col2, Tab0, Tab0a),
- remove_col(Col, Tab0a, Tab1)
- )
- ;
- Tab1 = Tab0
- ),
- remove_col(Col, Tab1, Tab2),
- fix_basis_and_rem_cols(Vs, Tab2, Tab).
-
-%------------------------------------------------------------------------------%
-
-:- type cell ---> cell(int, int).
-
-:- pred pivot(int, int, tableau, tableau).
-:- mode pivot(in, in, in, out) is det.
-
-pivot(P, Q, A0, A) :-
- index(A0, P, Q, Apq),
- MostCells = (pred(Cell::out) is nondet :-
- all_rows0(A0, J),
- J \= P,
- all_cols0(A0, K),
- K \= Q,
- Cell = cell(J, K)
- ),
- ScaleCell = (pred(Cell::in, T0::in, T::out) is det :-
- Cell = cell(J, K),
- index(T0, J, K, Ajk),
- index(T0, J, Q, Ajq),
- index(T0, P, K, Apk),
- NewAjk = Ajk - Apk * Ajq / Apq,
- set_index(T0, J, K, NewAjk, T)
- ),
- aggregate(MostCells, ScaleCell, A0, A1),
- QColumn = (pred(Cell::out) is nondet :-
- all_rows0(A1, J),
- Cell = cell(J, Q)
- ),
- Zero = (pred(Cell::in, T0::in, T::out) is det :-
- Cell = cell(J, K),
- set_index(T0, J, K, 0.0, T)
- ),
- aggregate(QColumn, Zero, A1, A2),
- PRow = all_cols0(A2),
- ScaleRow = (pred(K::in, T0::in, T::out) is det :-
- index(T0, P, K, Apk),
- NewApk = Apk / Apq,
- set_index(T0, P, K, NewApk, T)
- ),
- aggregate(PRow, ScaleRow, A2, A3),
- set_index(A3, P, Q, 1.0, A).
-
-:- pred row_op(float, int, int, tableau, tableau).
-:- mode row_op(in, in, in, in, out) is det.
-
-row_op(Scale, From, To, A0, A) :-
- AllCols = all_cols0(A0),
- AddRow = (pred(Col::in, T0::in, T::out) is det :-
- index(T0, From, Col, X),
- index(T0, To, Col, Y),
- Z = Y + (Scale * X),
- set_index(T0, To, Col, Z, T)
- ),
- aggregate(AllCols, AddRow, A0, A).
+ var_col(Tab, Var, Col),
+ GetCell = (pred(Val0::out) is nondet :-
+ all_rows(Tab, Row),
+ index(Tab, Row, Col, 1.0),
+ rhs_col(Tab, RHS),
+ index(Tab, Row, RHS, Val0)
+ ),
+ solutions(GetCell, Solns),
+ ( Solns = [Val1] ->
+ Val = Val1
+ ;
+ Val = 0.0
+ ).
+
+:- pred simplex(tableau::in, tableau::out, bool::out) is det.
+
+simplex(A0, A, Result) :-
+ AllColumns = all_cols(A0),
+ MinAgg = (pred(Col::in, Min0::in, Min::out) is det :-
+ (
+ Min0 = no,
+ index(A0, 0, Col, MinVal),
+ ( MinVal < 0.0 ->
+ Min = yes(Col - MinVal)
+ ;
+ Min = no
+ )
+ ;
+ Min0 = yes(_ - MinVal0),
+ index(A0, 0, Col, CellVal),
+ ( CellVal < MinVal0 ->
+ Min = yes(Col - CellVal)
+ ;
+ Min = Min0
+ )
+ )
+ ),
+ aggregate(AllColumns, MinAgg, no, MinResult),
+ (
+ MinResult = no,
+ A = A0,
+ Result = yes
+ ;
+ MinResult = yes(Q - _Val),
+ AllRows = all_rows(A0),
+ MaxAgg = (pred(Row::in, Max0::in, Max::out) is det :-
+ (
+ Max0 = no,
+ index(A0, Row, Q, MaxVal),
+ ( MaxVal > 0.0 ->
+ rhs_col(A0, RHSC),
+ index(A0, Row, RHSC, MVal),
+ CVal = MVal/MaxVal,
+ Max = yes(Row - CVal)
+ ;
+ Max = no
+ )
+ ;
+ Max0 = yes(_ - MaxVal0),
+ index(A0, Row, Q, CellVal),
+ rhs_col(A0, RHSC),
+ index(A0, Row, RHSC, MVal),
+ (
+ CellVal > 0.0,
+ MaxVal1 = MVal/CellVal,
+ MaxVal1 =< MaxVal0
+ ->
+ Max = yes(Row - MaxVal1)
+ ;
+ Max = Max0
+ )
+ )
+ ),
+ aggregate(AllRows, MaxAgg, no, MaxResult),
+ (
+ MaxResult = no,
+ A = A0,
+ Result = no
+ ;
+ MaxResult = yes(P - _),
+ pivot(P, Q, A0, A1),
+ simplex(A1, A, Result)
+ )
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred ensure_zero_obj_coeffs(list(var)::in, tableau::in, tableau::out)
+ is det.
+
+ensure_zero_obj_coeffs([], !Tableau).
+ensure_zero_obj_coeffs([V | Vs], !Tableau) :-
+ var_col(!.Tableau, V, Col),
+ index(!.Tableau, 0, Col, Val),
+ ( Val = 0.0 ->
+ ensure_zero_obj_coeffs(Vs, !Tableau)
+ ;
+ FindOne = (pred(P::out) is nondet :-
+ all_rows(!.Tableau, R),
+ index(!.Tableau, R, Col, ValF0),
+ ValF0 \= 0.0,
+ P = R - ValF0
+ ),
+ solutions(FindOne, Ones),
+ (
+ Ones = [Row - Fac0|_],
+ Fac = -Val/Fac0,
+ row_op(Fac, Row, 0, !Tableau),
+ ensure_zero_obj_coeffs(Vs, !Tableau)
+ ;
+ Ones = [],
+ error("problem with artificial variable")
+ )
+ ).
+
+:- pred fix_basis_and_rem_cols(list(var)::in, tableau::in, tableau::out)
+ is det.
+
+fix_basis_and_rem_cols([], !Tableau).
+fix_basis_and_rem_cols([V | Vs], !Tableau) :-
+ var_col(!.Tableau, V, Col),
+ BasisAgg = (pred(R::in, Ones0::in, Ones::out) is det :-
+ index(!.Tableau, R, Col, Val),
+ ( Val = 0.0 ->
+ Ones = Ones0
+ ;
+ Ones = [Val - R|Ones0]
+ )
+ ),
+ aggregate(all_rows(!.Tableau), BasisAgg, [], Res),
+ (
+ Res = [1.0 - Row]
+ ->
+ PivGoal = (pred(Col1::out) is nondet :-
+ all_cols(!.Tableau, Col1),
+ Col \= Col1,
+ index(!.Tableau, Row, Col1, Zz),
+ Zz \= 0.0
+ ),
+ solutions(PivGoal, PivSolns),
+ (
+ PivSolns = [],
+ remove_col(Col, !Tableau),
+ remove_row(Row, !Tableau)
+ ;
+ PivSolns = [Col2|_],
+ pivot(Row, Col2, !Tableau),
+ remove_col(Col, !Tableau)
+ )
+ ;
+ true
+ ),
+ remove_col(Col, !Tableau),
+ fix_basis_and_rem_cols(Vs, !Tableau).
+
+%------------------------------------------------------------------------------%
+
+:- type cell ---> cell(int, int).
+
+:- pred pivot(int::in, int::in, tableau::in, tableau::out) is det.
+
+pivot(P, Q, !Tableau) :-
+ index(!.Tableau, P, Q, Apq),
+ MostCells = (pred(Cell::out) is nondet :-
+ all_rows0(!.Tableau, J),
+ J \= P,
+ all_cols0(!.Tableau, K),
+ K \= Q,
+ Cell = cell(J, K)
+ ),
+ ScaleCell = (pred(Cell::in, !.T::in, !:T::out) is det :-
+ Cell = cell(J, K),
+ index(!.T, J, K, Ajk),
+ index(!.T, J, Q, Ajq),
+ index(!.T, P, K, Apk),
+ NewAjk = Ajk - Apk * Ajq / Apq,
+ set_index(J, K, NewAjk, !T)
+ ),
+ aggregate(MostCells, ScaleCell, !Tableau),
+ QColumn = (pred(Cell::out) is nondet :-
+ all_rows0(!.Tableau, J),
+ Cell = cell(J, Q)
+ ),
+ Zero = (pred(Cell::in, T0::in, T::out) is det :-
+ Cell = cell(J, K),
+ set_index(J, K, 0.0, T0, T)
+ ),
+ aggregate(QColumn, Zero, !Tableau),
+ PRow = all_cols0(!.Tableau),
+ ScaleRow = (pred(K::in, T0::in, T::out) is det :-
+ index(T0, P, K, Apk),
+ NewApk = Apk / Apq,
+ set_index(P, K, NewApk, T0, T)
+ ),
+ aggregate(PRow, ScaleRow, !Tableau),
+ set_index(P, Q, 1.0, !Tableau).
+
+:- pred row_op(float::in, int::in, int::in,
+ tableau::in, tableau::out) is det.
+
+row_op(Scale, From, To, !Tableau) :-
+ AllCols = all_cols0(!.Tableau),
+ AddRow = (pred(Col::in, !.Tableau::in, !:Tableau::out) is det :-
+ index(!.Tableau, From, Col, X),
+ index(!.Tableau, To, Col, Y),
+ Z = Y + (Scale * X),
+ set_index(To, Col, Z, !Tableau)
+ ),
+ aggregate(AllCols, AddRow, !Tableau).
%------------------------------------------------------------------------------%
:- type tableau
- ---> tableau(
- int,
- int,
- map(var, int),
- map(var, pair(var)),
- list(int), % shunned rows
- list(int), % shunned cols
- map(pair(int), float)
- ).
+ ---> tableau(
+ rows :: int,
+ cols :: int,
+ var_nums :: map(var, int),
+ urs_vars :: map(var, pair(var)),
+ shunned_rows :: list(int),
+ shunned_cols :: list(int),
+ cells :: map(pair(int), float)
+ ).
:- pred init_tableau(int::in, int::in, map(var, int)::in,
- map(var, pair(var))::in, tableau::out) is det.
+ map(var, pair(var))::in, tableau::out) is det.
init_tableau(Rows, Cols, VarNums, URSVars, Tableau) :-
- map__init(Cells),
- Tableau = tableau(Rows, Cols, VarNums, URSVars, [], [], Cells).
+ map.init(Cells),
+ Tableau = tableau(Rows, Cols, VarNums, URSVars, [], [], Cells).
-:- pred index(tableau, int, int, float).
-:- mode index(in, in, in, out) is det.
+:- pred index(tableau::in, int::in, int::in, float::out) is det.
index(Tableau, J, K, R) :-
- Tableau = tableau(_, _, _, _, SR, SC, Cells),
- (
- ( list__member(J, SR)
- ; list__member(K, SC)
- )
- ->
- error("attempt to address shunned row/col")
- ;
- true
- ),
- (
- map__search(Cells, J - K, R0)
- ->
- R = R0
- ;
- R = 0.0
- ).
-
-:- pred set_index(tableau, int, int, float, tableau).
-:- mode set_index(in, in, in, in, out) is det.
-
-set_index(Tableau0, J, K, R, Tableau) :-
- Tableau0 = tableau(Rows, Cols, VarNums, URS, SR, SC, Cells0),
- (
- ( list__member(J, SR)
- ; list__member(K, SC)
- )
- ->
- error("attempt to write shunned row/col")
- ;
- true
- ),
- ( R = 0.0 ->
- map__delete(Cells0, J - K, Cells)
- ;
- map__set(Cells0, J - K, R, Cells)
- ),
- Tableau = tableau(Rows, Cols, VarNums, URS, SR, SC, Cells).
+ Tableau = tableau(_, _, _, _, SR, SC, Cells),
+ (
+ (list.member(J, SR) ; list.member(K, SC))
+ ->
+ error("attempt to address shunned row/col")
+ ;
+ true
+ ),
+ (
+ map.search(Cells, J - K, R0)
+ ->
+ R = R0
+ ;
+ R = 0.0
+ ).
+
+:- pred set_index(int::in, int::in, float::in,
+ tableau::in, tableau::out) is det.
+
+set_index(J, K, R, !Tableau) :-
+ !.Tableau = tableau(Rows, Cols, VarNums, URS, SR, SC, Cells0),
+ (
+ (list.member(J, SR) ; list.member(K, SC))
+ ->
+ error("attempt to write shunned row/col")
+ ;
+ true
+ ),
+ ( R = 0.0 ->
+ map.delete(Cells0, J - K, Cells)
+ ;
+ map.set(Cells0, J - K, R, Cells)
+ ),
+ !:Tableau = tableau(Rows, Cols, VarNums, URS, SR, SC, Cells).
-:- pred rhs_col(tableau, int).
-:- mode rhs_col(in, out) is det.
+:- pred rhs_col(tableau::in, int::out) is det.
rhs_col(tableau(_, RHS, _, _, _, _, _), RHS).
-:- pred all_rows0(tableau, int).
-:- mode all_rows0(in, out) is nondet.
+:- pred all_rows0(tableau::in, int::out) is nondet.
all_rows0(Tableau, Row) :-
- Tableau = tableau(Rows, _Cols, _, _, SR, _, _),
- between(0, Rows, Row),
- \+ list__member(Row, SR).
+ Tableau = tableau(Rows, _Cols, _, _, SR, _, _),
+ between(0, Rows, Row),
+ \+ list.member(Row, SR).
-:- pred all_rows(tableau, int).
-:- mode all_rows(in, out) is nondet.
+:- pred all_rows(tableau::in, int::out) is nondet.
all_rows(Tableau, Row) :-
- Tableau = tableau(Rows, _Cols, _, _, SR, _, _),
- between(1, Rows, Row),
- \+ list__member(Row, SR).
+ Tableau = tableau(Rows, _Cols, _, _, SR, _, _),
+ between(1, Rows, Row),
+ \+ list.member(Row, SR).
-:- pred all_cols0(tableau, int).
-:- mode all_cols0(in, out) is nondet.
+:- pred all_cols0(tableau::in, int::out) is nondet.
all_cols0(Tableau, Col) :-
- Tableau = tableau(_Rows, Cols, _, _, _, SC, _),
- between(0, Cols, Col),
- \+ list__member(Col, SC).
+ Tableau = tableau(_Rows, Cols, _, _, _, SC, _),
+ between(0, Cols, Col),
+ \+ list.member(Col, SC).
-:- pred all_cols(tableau, int).
-:- mode all_cols(in, out) is nondet.
+:- pred all_cols(tableau::in, int::out) is nondet.
all_cols(Tableau, Col) :-
- Tableau = tableau(_Rows, Cols, _, _, _, SC, _),
- Cols1 = Cols - 1,
- between(0, Cols1, Col),
- \+ list__member(Col, SC).
+ Tableau = tableau(_Rows, Cols, _, _, _, SC, _),
+ Cols1 = Cols - 1,
+ between(0, Cols1, Col),
+ \+ list.member(Col, SC).
-:- pred var_col(tableau, var, int).
-:- mode var_col(in, in, out) is det.
+:- pred var_col(tableau::in, var::in, int::out) is det.
var_col(Tableau, Var, Col) :-
- Tableau = tableau(_, _, VarCols, _, _, _, _),
- map__lookup(VarCols, Var, Col).
+ Tableau = tableau(_, _, VarCols, _, _, _, _),
+ map.lookup(VarCols, Var, Col).
-:- pred urs_vars(tableau, map(var, pair(var))).
-:- mode urs_vars(in, out) is det.
+:- pred urs_vars(tableau::in, map(var, pair(var))::out) is det.
-urs_vars(Tableau, URS) :-
- Tableau = tableau(_, _, _, URS, _, _, _).
+urs_vars(Tableau, Tableau ^ urs_vars).
-:- pred remove_row(int, tableau, tableau).
-:- mode remove_row(in, in, out) is det.
+:- pred remove_row(int::in, tableau::in, tableau::out) is det.
remove_row(R, Tableau0, Tableau) :-
- Tableau0 = tableau(Rows, Cols, VarNums, URS, SR, SC, Cells),
- Tableau = tableau(Rows, Cols, VarNums, URS, [R|SR], SC, Cells).
+ Tableau0 = tableau(Rows, Cols, VarNums, URS, SR, SC, Cells),
+ Tableau = tableau(Rows, Cols, VarNums, URS, [R|SR], SC, Cells).
-:- pred remove_col(int, tableau, tableau).
-:- mode remove_col(in, in, out) is det.
+:- pred remove_col(int::in, tableau::in, tableau::out) is det.
remove_col(C, Tableau0, Tableau) :-
- Tableau0 = tableau(Rows, Cols, VarNums, URS, SR, SC, Cells),
- Tableau = tableau(Rows, Cols, VarNums, URS, SR, [C|SC], Cells).
+ Tableau0 = tableau(Rows, Cols, VarNums, URS, SR, SC, Cells),
+ Tableau = tableau(Rows, Cols, VarNums, URS, SR, [C|SC], Cells).
-:- pred get_basis_vars(tableau, list(var)).
-:- mode get_basis_vars(in, out) is det.
+:- pred get_basis_vars(tableau::in, list(var)::out) is det.
get_basis_vars(Tab, Vars) :-
- BasisCol = (pred(C::out) is nondet :-
- all_cols(Tab, C),
- NonZeroGoal = (pred(P::out) is nondet :-
- all_rows(Tab, R),
- index(Tab, R, C, Z),
- Z \= 0.0,
- P = R - Z
- ),
- solutions(NonZeroGoal, Solns),
- Solns = [_ - 1.0]
- ),
- solutions(BasisCol, Cols),
- BasisVars = (pred(V::out) is nondet :-
- list__member(Col, Cols),
- Tab = tableau(_, _, VarCols, _, _, _, _),
- map__member(VarCols, V, Col)
- ),
- solutions(BasisVars, Vars).
+ BasisCol = (pred(C::out) is nondet :-
+ all_cols(Tab, C),
+ NonZeroGoal = (pred(P::out) is nondet :-
+ all_rows(Tab, R),
+ index(Tab, R, C, Z),
+ Z \= 0.0,
+ P = R - Z
+ ),
+ solutions(NonZeroGoal, Solns),
+ Solns = [_ - 1.0]
+ ),
+ solutions(BasisCol, Cols),
+ BasisVars = (pred(V::out) is nondet :-
+ list.member(Col, Cols),
+ Tab = tableau(_, _, VarCols, _, _, _, _),
+ map.member(VarCols, V, Col)
+ ),
+ solutions(BasisVars, Vars).
%------------------------------------------------------------------------------%
- % For debugging ....
-
-:- pred show_tableau(tableau, io__state, io__state).
-:- mode show_tableau(in, di, uo) is det.
-
-show_tableau(Tableau) -->
- { Tableau = tableau(N, M, _, _, _, _, _) },
- { string__format("Tableau (%d, %d):\n", [i(N), i(M)], Str) },
- io__write_string(Str),
- aggregate(all_rows0(Tableau), show_row(Tableau)).
-
-:- pred show_row(tableau, int, io__state, io__state).
-:- mode show_row(in, in, di, uo) is det.
-
-show_row(Tableau, Row) -->
- aggregate(all_cols0(Tableau), show_cell(Tableau, Row)),
- io__write_string("\n").
-
-:- pred show_cell(tableau, int, int, io__state, io__state).
-:- mode show_cell(in, in, in, di, uo) is det.
-
-show_cell(Tableau, Row, Col) -->
- { index(Tableau, Row, Col, Val) },
- { string__format("%2.2f\t", [f(Val)], Str) },
- io__write_string(Str).
-
-%------------------------------------------------------------------------------%
-
-:- pred lp_info_init(varset, list(var), lp_info).
-:- mode lp_info_init(in, in, out) is det.
+:- pred lp_info_init(varset::in, list(var)::in, lp_info::out) is det.
lp_info_init(Varset0, URSVars, LPInfo) :-
- Introduce = (pred(Orig::in, VP0::in, VP::out) is det :-
- VP0 = VS0 - VM0,
- varset__new_var(VS0, V1, VS1),
- varset__new_var(VS1, V2, VS),
- map__set(VM0, Orig, V1 - V2, VM),
- VP = VS - VM
- ),
- map__init(URSMap0),
- list__foldl(Introduce, URSVars, Varset0 - URSMap0, Varset - URSMap),
- LPInfo = lp(Varset, URSMap, [], []).
+ Introduce = (pred(Orig::in, VP0::in, VP::out) is det :-
+ VP0 = VS0 - VM0,
+ varset.new_var(VS0, V1, VS1),
+ varset.new_var(VS1, V2, VS),
+ map.set(VM0, Orig, V1 - V2, VM),
+ VP = VS - VM
+ ),
+ map.init(URSMap0),
+ list.foldl(Introduce, URSVars, Varset0 - URSMap0, Varset - URSMap),
+ LPInfo = lp(Varset, URSMap, [], []).
:- pred new_slack_var(var::out, lp_info::in, lp_info::out) is det.
-new_slack_var(Var) -->
- get_varset(Varset0),
- { varset__new_var(Varset0, Var, Varset) },
- set_varset(Varset),
- get_slack_vars(Vars),
- set_slack_vars([Var|Vars]).
+new_slack_var(Var, !Info) :-
+ some [!Varset] (
+ get_varset(!:Varset, !Info),
+ svvarset.new_var(Var, !Varset),
+ set_varset(!.Varset, !Info)
+ ),
+ get_slack_vars(Vars, !Info),
+ set_slack_vars([Var | Vars], !Info).
:- pred new_art_var(var::out, lp_info::in, lp_info::out) is det.
-new_art_var(Var) -->
- get_varset(Varset0),
- { varset__new_var(Varset0, Var, Varset) },
- set_varset(Varset),
- get_art_vars(Vars),
- set_art_vars([Var|Vars]).
+new_art_var(Var, !Info) :-
+ some [!Varset] (
+ get_varset(!:Varset, !Info),
+ svvarset.new_var(Var, !Varset),
+ set_varset(!.Varset, !Info)
+ ),
+ get_art_vars(Vars, !Info),
+ set_art_vars([Var | Vars], !Info).
:- pred get_varset(varset::out, lp_info::in, lp_info::out) is det.
get_varset(Varset, Info, Info) :-
- Info = lp(Varset, _URSVars, _Slack, _Art).
+ Info = lp(Varset, _URSVars, _Slack, _Art).
:- pred set_varset(varset::in, lp_info::in, lp_info::out) is det.
set_varset(Varset, Info0, Info) :-
- Info0 = lp(_Varset, URSVars, Slack, Art),
- Info = lp(Varset, URSVars, Slack, Art).
+ Info0 = lp(_Varset, URSVars, Slack, Art),
+ Info = lp(Varset, URSVars, Slack, Art).
:- pred get_urs_vars(map(var, pair(var))::out, lp_info::in, lp_info::out) is det.
get_urs_vars(URSVars, Info, Info) :-
- Info = lp(_Varset, URSVars, _Slack, _Art).
+ Info = lp(_Varset, URSVars, _Slack, _Art).
:- pred set_urs_vars(map(var, pair(var))::in, lp_info::in, lp_info::out) is det.
set_urs_vars(URSVars, Info0, Info) :-
- Info0 = lp(Varset, _URSVars, Slack, Art),
- Info = lp(Varset, URSVars, Slack, Art).
+ Info0 = lp(Varset, _URSVars, Slack, Art),
+ Info = lp(Varset, URSVars, Slack, Art).
:- pred get_slack_vars(list(var)::out, lp_info::in, lp_info::out) is det.
get_slack_vars(Slack, Info, Info) :-
- Info = lp(_Varset, _URSVars, Slack, _Art).
+ Info = lp(_Varset, _URSVars, Slack, _Art).
:- pred set_slack_vars(list(var)::in, lp_info::in, lp_info::out) is det.
set_slack_vars(Slack, Info0, Info) :-
- Info0 = lp(Varset, URSVars, _Slack, Art),
- Info = lp(Varset, URSVars, Slack, Art).
+ Info0 = lp(Varset, URSVars, _Slack, Art),
+ Info = lp(Varset, URSVars, Slack, Art).
:- pred get_art_vars(list(var)::out, lp_info::in, lp_info::out) is det.
get_art_vars(Art, Info, Info) :-
- Info = lp(_Varset, _URSVars, _Slack, Art).
+ Info = lp(_Varset, _URSVars, _Slack, Art).
:- pred set_art_vars(list(var)::in, lp_info::in, lp_info::out) is det.
set_art_vars(Art, Info0, Info) :-
- Info0 = lp(Varset, URSVars, Slack, _Art),
- Info = lp(Varset, URSVars, Slack, Art).
+ Info0 = lp(Varset, URSVars, Slack, _Art),
+ Info = lp(Varset, URSVars, Slack, Art).
%------------------------------------------------------------------------------%
-:- pred between(int, int, int).
-:- mode between(in, in, out) is nondet.
+:- pred between(int::in, int::in, int::out) is nondet.
between(Min, Max, I) :-
- Min =< Max,
- (
- I = Min
- ;
- Min1 = Min + 1,
- between(Min1, Max, I)
- ).
+ Min =< Max,
+ (
+ I = Min
+ ;
+ Min1 = Min + 1,
+ between(Min1, Max, I)
+ ).
+
+%------------------------------------------------------------------------------%
+%
+% Debugging predicates.
+%
+
+:- pred show_tableau(tableau::in, io::di, io::uo) is det.
+
+show_tableau(Tableau, !IO) :-
+ Tableau = tableau(N, M, _, _, _, _, _),
+ io.format("Tableau (%d, %d):\n", [i(N), i(M)], !IO),
+ aggregate(all_rows0(Tableau), show_row(Tableau), !IO).
+
+:- pred show_row(tableau::in, int::in, io::di, io::uo) is det.
+
+show_row(Tableau, Row, !IO) :-
+ aggregate(all_cols0(Tableau), show_cell(Tableau, Row), !IO),
+ io.nl(!IO).
+
+:- pred show_cell(tableau::in, int::in, int::in, io::di, io::uo) is det.
+
+show_cell(Tableau, Row, Col, !IO) :-
+ index(Tableau, Row, Col, Val),
+ io.format("%2.2f\t", [f(Val)], !IO).
%------------------------------------------------------------------------------%
+:- end_module lp.
%------------------------------------------------------------------------------%
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.20
diff -u -r1.20 term_pass1.m
--- compiler/term_pass1.m 24 Mar 2005 05:34:15 -0000 1.20
+++ compiler/term_pass1.m 18 Apr 2005 06:45:54 -0000
@@ -59,10 +59,9 @@
:- import_module check_hlds__type_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
+:- import_module libs__lp.
:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
-:- import_module transform_hlds__lp.
-:- import_module transform_hlds__term_errors.
:- import_module transform_hlds__term_traversal.
:- import_module bag.
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.17
diff -u -r1.17 transform_hlds.m
--- compiler/transform_hlds.m 7 Apr 2005 06:32:17 -0000 1.17
+++ compiler/transform_hlds.m 18 Apr 2005 06:47:07 -0000
@@ -38,22 +38,18 @@
:- include_module term_errors.
:- include_module term_norm.
:- include_module term_util.
- :- include_module lp. % this could alternatively go in the `libs' module
:- include_module term_constr_main.
- %
- % The termination analyser.
- %
- :- include_module term_constr_initial.
+ :- include_module term_constr_initial.
% Pass 1.
- :- include_module term_constr_build.
- :- include_module term_constr_fixpoint.
+ :- include_module term_constr_build.
+ :- include_module term_constr_fixpoint.
% Pass 2.
- :- include_module term_constr_pass2.
+ :- include_module term_constr_pass2.
% Other bits.
- :- include_module term_constr_util.
- :- include_module term_constr_data.
- :- include_module term_constr_errors.
+ :- include_module term_constr_util.
+ :- include_module term_constr_data.
+ :- include_module term_constr_errors.
:- include_module post_term_analysis.
:- include_module exception_analysis.
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.100
diff -u -r1.100 compiler_design.html
--- compiler/notes/compiler_design.html 31 Mar 2005 04:44:24 -0000 1.100
+++ compiler/notes/compiler_design.html 18 Apr 2005 06:51:49 -0000
@@ -823,11 +823,6 @@
<li>
post_term_analysis.m contains error checking routines and optimizations
that depend upon the information obtained by termination analysis.
-<li>
-lp.m is used by term_pass1.m. It implements the Linear Programming
-algorithm for optimizing a set of linear constraints with respect to
-a linear cost function. (XXX Perhaps this should be put in the libs.m
-package rather than the check_hlds.m package.)
</ul>
<p>
@@ -1573,6 +1568,11 @@
Used by the LLDS, RL, and IL back-ends for collecting
together the different fragments of the generated code.
+ <dt> lp.m
+ <dd>
+ Implements the linear programming algorithm for optimizing
+ a set of linear constraints with respect to a linear
+ cost function. This is used by termination analyser.
</dl>
<hr>
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list