diff: new regression test
Fergus Henderson
fjh at cs.mu.OZ.AU
Thu Oct 1 17:08:00 AEST 1998
Estimated hours taken: 0.5
tests/hard_coded/Mmakefile:
tests/hard_coded/bigtest.m:
tests/hard_coded/lp.m:
tests/hard_coded/bigtest.exp:
Add a regression test for a bug that conway reported,
which appears to have already been fixed.
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.41
diff -u -r1.41 Mmakefile
--- Mmakefile 1998/09/24 10:11:49 1.41
+++ Mmakefile 1998/10/01 06:59:34
@@ -10,6 +10,7 @@
address_of_builtins \
agg \
bidirectional \
+ bigtest \
boyer \
c_write_string \
cc_nondet_disj \
@@ -105,6 +106,7 @@
MCFLAGS-no_fully_strict = --no-fully-strict
MCFLAGS-nondet_ctrl_vn = --optimize-value-number
MCFLAGS-rnd = -O6
+MCFLAGS-bigtest = --intermodule-optimization -O3
# In grade `none' with options `-O1 --opt-space' on kryten
# (a sparc-sun-solaris2.5 system), mode_choice needs to be linked
Index: tests/hard_coded/bigtest.exp
===================================================================
RCS file: bigtest.exp
diff -N bigtest.exp
--- /dev/null Thu Oct 1 17:05:01 1998
+++ bigtest.exp Thu Oct 1 16:58:56 1998
@@ -0,0 +1 @@
+satisfiable.
Index: tests/hard_coded/bigtest.m
===================================================================
RCS file: bigtest.m
diff -N bigtest.m
--- /dev/null Thu Oct 1 17:05:01 1998
+++ bigtest.m Thu Oct 1 16:58:05 1998
@@ -0,0 +1,48 @@
+%
+% This is a regression test --
+% a previous version of Mercury generated code for this test
+% which ran out of memory, if the test was compiled with `-O3'.
+%
+
+:- module bigtest.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module lp.
+:- import_module float, list, require, std_util, term, varset.
+
+main -->
+ { data(Eqns, Dir, Obj, Varset) },
+ lp_solve(Eqns, Dir, Obj, Varset, Result),
+ (
+ { Result = satisfiable(_, _) },
+ io__write_string("satisfiable.\n")
+ ;
+ { Result = unsatisfiable },
+ io__write_string("unsatisfiable.\n")
+ ).
+
+:- pred data(equations::out, direction::out, objective::out,
+ varset::out) is det.
+
+data(Eqns, max, Obj, Varset) :-
+ varset__init(Varset0 ),
+ varset__new_vars(Varset0, 80, Vars0, Varset),
+ list__sort(Vars0, Vars),
+ list__map(mkeqn, Vars, Eqns),
+ list__map(mkobj, Vars, Obj).
+
+:- pred mkeqn(var::in, equation::out) is det.
+
+mkeqn(Var, eqn([Var - 1.0], (=<), 42.0)).
+
+:- pred mkobj(var::in, coeff::out) is det.
+
+mkobj(Var, Var - 1.0).
+
Index: tests/hard_coded/lp.m
===================================================================
RCS file: lp.m
diff -N lp.m
--- /dev/null Thu Oct 1 17:05:01 1998
+++ lp.m Thu Oct 1 16:55:54 1998
@@ -0,0 +1,416 @@
+%------------------------------------------------------------------------------%
+
+:- module lp.
+
+:- interface.
+
+%------------------------------------------------------------------------------%
+
+:- import_module float, io, list, map, std_util, term, varset.
+
+:- type coeff == pair(var, float).
+
+:- type equation
+ ---> eqn(list(coeff), operator, float).
+
+:- type operator
+ ---> (=<) ; (=) ; (>=) .
+
+:- type equations == list(equation).
+
+:- type objective == list(coeff).
+
+:- type direction
+ ---> max ; min .
+
+:- type lp__result
+ ---> unsatisfiable
+ ; satisfiable(float, map(var, float))
+ .
+
+%------------------------------------------------------------------------------%
+
+:- pred lp_solve(equations, direction, objective, varset, lp__result,
+ io__state, io__state).
+:- mode lp_solve(in, in, in, in, out, di, uo) is cc_multi.
+
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array, bool, int, require, set.
+
+lp_solve(Equations, Dir, Objective, Varset0, Result, IO0, IO) :-
+ form_tableau(Equations, Dir, Objective, Varset0,
+ VarNumbers, N, M, Tableau0),
+ show_tableau(N, M, Tableau0, IO0, IO1),
+ simplex(N, M, Tableau0, Tableau, Resolved, IO1, IO2),
+ show_tableau(N, M, Tableau, IO2, IO),
+ (
+ Resolved = yes,
+ index(Tableau, N, M, 0, M, ObjVal),
+ GetObjVar = lambda([Var::out] is nondet, (
+ list__member(Coeff, Objective),
+ Coeff = Var - _
+ )),
+ solutions(GetObjVar, ObjVars),
+ map__init(ObjVarVals0),
+ list__foldl(objvarval(Tableau, VarNumbers, N, M), ObjVars,
+ ObjVarVals0, ObjVarVals),
+ Result = satisfiable(ObjVal, ObjVarVals)
+ ;
+ Resolved = no,
+ Result = unsatisfiable
+ ).
+
+:- pred form_tableau(equations, direction, objective, varset,
+ map(var, int), int, int, tableau).
+:- mode form_tableau(in, in, in, in, out, out, out, out) is det.
+
+form_tableau(Equations, Dir, Objective, Varset0,
+ VarNumbers, NumNormEqns1, NumVars1, Tableau) :-
+ N = NumNormEqns1,
+ M = NumVars1,
+ normalize_equations(Equations, [], NormalEquations0, Varset0, _Varset),
+ list__map(simplify, NormalEquations0, NormalEquations1),
+ list__reverse(NormalEquations1, NormalEquations),
+ list__length(NormalEquations, NumNormEqns),
+ collect_vars(NormalEquations, Objective, Vars),
+ set__to_sorted_list(Vars, VarList),
+ list__length(VarList, NumVars),
+ NumVars1 is NumVars,
+ NumNormEqns1 is NumNormEqns,
+ init_tableau(NumNormEqns1, NumVars1, Tableau0),
+ map__init(VarNumbers0),
+ number_vars(VarList, 0, VarNumbers0, VarNumbers),
+ (
+ Dir = max,
+ Neg = lambda([Pair0::in, Pair::out] is det, (
+ Pair0 = V - X0,
+ X1 is -X0,
+ Pair = V - (X1)
+ )),
+ list__map(Neg, Objective, NegObjective)
+ ;
+ Dir = min,
+ NegObjective = Objective
+ ),
+ insert_coeffs(NegObjective, 0, VarNumbers, N, M, Tableau0, Tableau1),
+ insert_equations(NormalEquations, 1, NumVars1, VarNumbers,
+ N, M, Tableau1, Tableau).
+
+:- pred normalize_equations(equations, equations, equations, varset, varset).
+:- mode normalize_equations(in, in, out, in, out) is det.
+
+normalize_equations([], NormalEquations, NormalEquations, Varset, Varset).
+normalize_equations([Eqn0|Eqns], NEqns0, NEqns, Varset0, Varset) :-
+ Eqn0 = eqn(Coeffs0, Op0, Const0),
+ (
+ Op0 = (=),
+ Varset1 = Varset0,
+ NEqns1 = [Eqn0|NEqns0]
+ ;
+ Op0 = (=<),
+ varset__new_var(Varset0, Var, Varset1),
+ Eqn1 = eqn([Var - 1.0|Coeffs0], (=), Const0),
+ NEqns1 = [Eqn1|NEqns0]
+ ;
+ Op0 = (>=),
+ varset__new_var(Varset0, Var, Varset1),
+ Eqn1 = eqn([Var - (-1.0)|Coeffs0], (=), Const0),
+ NEqns1 = [Eqn1|NEqns0]
+ ),
+ normalize_equations(Eqns, NEqns1, NEqns, Varset1, Varset).
+
+:- pred simplify(equation, equation).
+:- mode simplify(in, out) is det.
+
+simplify(eqn(Coeffs0, Op, Const), eqn(Coeffs, Op, Const)) :-
+ map__init(CoeffMap0),
+ AddCoeff = lambda([Pair::in, Map0::in, Map::out] is det, (
+ Pair = Var - Coeff,
+ ( map__search(Map0, Var, Acc0) ->
+ Acc1 = Acc0
+ ;
+ Acc1 = 0.0
+ ),
+ Acc is Acc1 + Coeff,
+ map__set(Map0, Var, Acc, Map)
+ )),
+ list__foldl(AddCoeff, Coeffs0, CoeffMap0, CoeffMap),
+ map__to_assoc_list(CoeffMap, Coeffs).
+
+:- pred collect_vars(equations, objective, set(var)).
+:- mode collect_vars(in, in, out) is det.
+
+collect_vars(Eqns, Obj, Vars) :-
+ GetVar = lambda([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([], _, VarNumbers, VarNumbers).
+number_vars([Var|Vars], N, VarNumbers0, VarNumbers) :-
+ map__det_insert(VarNumbers0, Var, N, VarNumbers1),
+ N1 is N + 1,
+ number_vars(Vars, N1, VarNumbers1, VarNumbers).
+
+:- pred insert_equations(equations, int, int, map(var, int),
+ int, int, tableau, tableau).
+:- mode insert_equations(in, in, in, in, in, in, in, out) is det.
+
+insert_equations([], _, _, _, _, _, Tableau, Tableau).
+insert_equations([Eqn|Eqns], Row, ConstCol, VarNumbers, N, M,
+ Tableau0, Tableau) :-
+ Eqn = eqn(Coeffs, _Op, Const),
+ insert_coeffs(Coeffs, Row, VarNumbers, N, M, Tableau0, Tableau1),
+ set_index(Tableau1, N, M, Row, ConstCol, Const, Tableau2),
+ Row1 is Row + 1,
+ insert_equations(Eqns, Row1, ConstCol, VarNumbers, N, M,
+ Tableau2, Tableau).
+
+:- pred insert_coeffs(list(coeff), int, map(var, int), int, int,
+ tableau, tableau).
+:- mode insert_coeffs(in, in, in, in, in, in, out) is det.
+
+insert_coeffs([], _Row, _VarNumbers, _N, _M, Tableau, Tableau).
+insert_coeffs([Coeff|Coeffs], Row, VarNumbers, N, M, Tableau0, Tableau) :-
+ Coeff = Var - Const,
+ map__lookup(VarNumbers, Var, Col),
+ set_index(Tableau0, N, M, Row, Col, Const, Tableau1),
+ insert_coeffs(Coeffs, Row, VarNumbers, N, M, Tableau1, Tableau).
+
+:- pred objvarval(tableau, map(var, int), int, int, var,
+ map(var, float), map(var, float)).
+:- mode objvarval(in, in, in, in, in, in, out) is det.
+
+objvarval(Tableau, VarNumbers, N, M, Var, ObjVarVals0, ObjVarVals) :-
+ map__lookup(VarNumbers, Var, Col),
+ SelectRow = lambda([VV::out] is nondet, (
+ between(1, N, Row),
+ index(Tableau, N, M, Row, Col, V),
+ V = 1.0,
+ index(Tableau, N, M, Row, M, VV)
+ )),
+ solutions(SelectRow, ObjVarValList),
+ (
+ ObjVarValList = [ObjVarVal|_]
+ ->
+ map__set(ObjVarVals0, Var, ObjVarVal, ObjVarVals)
+ ;
+ error("inconsistent simplex")
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred simplex(int, int, tableau, tableau, bool, io__state, io__state).
+:- mode simplex(in, in, in, out, out, di, uo) is cc_multi.
+
+simplex(N, M, A0, A, Result, IO0, IO) :-
+ AllColumns = lambda([Col::out] is nondet, between(0, M-1, Col)),
+ MinAgg = lambda([Col::in, Min0::in, Min::out] is det, (
+ (
+ Min0 = no,
+ index(A0, N, M, 0, Col, MinVal),
+ ( MinVal < 0.0 ->
+ Min = yes(Col - MinVal)
+ ;
+ Min = no
+ )
+ ;
+ Min0 = yes(_ - MinVal0),
+ index(A0, N, M, 0, Col, CellVal),
+ ( CellVal < MinVal0 ->
+ Min = yes(Col - CellVal)
+ ;
+ Min = Min0
+ )
+ )
+ )),
+ unsorted_aggregate(AllColumns, MinAgg, no, MinResult),
+ (
+ MinResult = no,
+ A = A0,
+ IO = IO0,
+ Result = yes
+ ;
+ MinResult = yes(Q - _Val),
+ AllRows = lambda([Row::out] is nondet, between(1, N, Row)),
+ MaxAgg = lambda([Row::in, Max0::in, Max::out] is det, (
+ (
+ Max0 = no,
+ index(A0, N, M, Row, Q, MaxVal),
+ ( MaxVal > 0.0 ->
+ index(A0, N, M, Row, M, MVal),
+ CVal is MVal/MaxVal,
+ Max = yes(Row - CVal)
+ ;
+ Max = no
+ )
+ ;
+ Max0 = yes(_ - MaxVal0),
+ index(A0, N, M, Row, Q, CellVal),
+ index(A0, N, M, Row, M, MVal),
+ MaxVal1 is MVal/CellVal,
+ ( CellVal > 0.0, MaxVal1 =< MaxVal0 ->
+ Max = yes(Row - MaxVal1)
+ ;
+ Max = Max0
+ )
+ )
+ )),
+ unsorted_aggregate(AllRows, MaxAgg, no, MaxResult),
+ (
+ MaxResult = no,
+ A = A0,
+ IO = IO0,
+ Result = no
+ ;
+ MaxResult = yes(P - _),
+ /*
+ index(A0, N, M, P, Q, Apq),
+ string__format("pivot on (%d, %d) = %f\n",
+ [i(P), i(Q), f(Apq)], Str),
+ io__write_string(Str, IO0, IO1),
+ */
+ IO1 = IO0,
+ pivot(P, Q, N, M, A0, A1),
+ show_tableau(N, M, A1, IO1, IO2),
+ simplex(N, M, A1, A, Result, IO2, IO)
+ )
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- type cell ---> cell(int, int).
+
+:- pred pivot(int, int, int, int, tableau, tableau).
+:- mode pivot(in, in, in, in, in, out) is cc_multi.
+
+pivot(P, Q, N, M, A0, A) :-
+ index(A0, N, M, P, Q, Apq),
+ MostCells = lambda([Cell::out] is nondet, (
+ between(0, N, J),
+ J \= P,
+ between(0, M, K),
+ K \= Q,
+ Cell = cell(J, K)
+ )),
+ ScaleCell = lambda([Cell::in, T0::in, T::out] is det, (
+ Cell = cell(J, K),
+ index(T0, N, M, J, K, Ajk),
+ index(T0, N, M, J, Q, Ajq),
+ index(T0, N, M, P, K, Apk),
+ NewAjk is Ajk - Apk * Ajq / Apq,
+ set_index(T0, N, M, J, K, NewAjk, T)
+ )),
+ unsorted_aggregate(MostCells, ScaleCell, A0, A1),
+ QColumn = lambda([Cell::out] is nondet, (
+ between(0, N, J),
+ Cell = cell(J, Q)
+ )),
+ Zero = lambda([Cell::in, T0::in, T::out] is det, (
+ Cell = cell(J, K),
+ set_index(T0, N, M, J, K, 0.0, T)
+ )),
+ aggregate(QColumn, Zero, A1, A2),
+ PRow = lambda([K::out] is nondet, between(0, M, K)),
+ ScaleRow = lambda([K::in, T0::in, T::out] is det, (
+ index(T0, N, M, P, K, Apk),
+ NewApk is Apk / Apq,
+ set_index(T0, N, M, P, K, NewApk, T)
+ )),
+ aggregate(PRow, ScaleRow, A2, A3),
+ set_index(A3, N, M, P, Q, 1.0, A).
+
+%------------------------------------------------------------------------------%
+
+:- type tableau == array(float).
+
+:- pred init_tableau(int::in, int::in, tableau::out) is det.
+
+init_tableau(Rows0, Cols0, Tableau) :-
+ Rows is Rows0 + 1, Cols is Cols0 + 1,
+ NumCells = Rows*Cols,
+ array__init(NumCells, 0.0, Tableau).
+
+:- pred index(tableau, int, int, int, int, float).
+:- mode index(in, in, in, in, in, out) is det.
+
+index(Tableau, Rows0, Cols0, J, K, R) :-
+ _Rows is Rows0 + 1, Cols is Cols0 + 1,
+ Index = J * Cols + K,
+ array__lookup(Tableau, Index, R).
+
+:- pred set_index(tableau, int, int, int, int, float, tableau).
+:- mode set_index(in, in, in, in, in, in, out) is det.
+
+set_index(Tableau0, Rows0, Cols0, J, K, R, Tableau) :-
+ _Rows is Rows0 + 1, Cols is Cols0 + 1,
+ Index = J * Cols + K,
+ mkuniq(Tableau0, Tableau1),
+ array__set(Tableau1, Index, R, Tableau).
+
+:- pred mkuniq(array(float)::in, array(float)::array_uo) is det.
+
+:- pragma c_code(mkuniq(A::in, B::array_uo), "B = A;").
+
+%------------------------------------------------------------------------------%
+
+:- import_module string.
+
+:- pred show_tableau(int, int, tableau, io__state, io__state).
+:- mode show_tableau(in, in, in, di, uo) is det.
+
+show_tableau(_N, _M, _Tableau) --> [].
+
+/*
+show_tableau(N, M, Tableau) -->
+ { string__format("Tableau (%d, %d):\n", [i(N), i(M)], Str) },
+ io__write_string(Str),
+ unsorted_aggregate(between(0, N), show_row(Tableau, M)).
+
+:- pred show_row(tableau, int, int, io__state, io__state).
+:- mode show_row(in, in, in, di, uo) is cc_multi.
+
+show_row(Tableau, M, Row) -->
+ unsorted_aggregate(between(0, M), 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 cc_multi.
+
+show_cell(Tableau, Row, Col) -->
+ { index(Tableau, Row, Col, Val) },
+ { string__format("%2.2f\t", [f(Val)], Str) },
+ io__write_string(Str).
+*/
+
+%------------------------------------------------------------------------------%
+
+:- pred between(int, int, int).
+:- mode between(in, in, out) is nondet.
+
+between(Min, Max, I) :-
+ Min =< Max,
+ (
+ I = Min
+ ;
+ Min1 is Min + 1,
+ between(Min1, Max, I)
+ ).
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
More information about the developers
mailing list