├── .gitignore ├── src ├── dune ├── version.ml ├── version.mli ├── basic.ml ├── solveBounds.mli ├── result.mli ├── basic.mli ├── core.mli ├── polys.mli ├── assertBounds.mli ├── rat2.mli ├── rat2.ml ├── polys.ml ├── extSigs.mli ├── result.ml ├── coreSig.mli ├── assertBounds.ml ├── solveBounds.ml └── core.ml ├── .editorconfig ├── tests ├── standalone_test_strict_bounds.expected ├── solveEmpty.ml ├── dune ├── solveEmpty.expected ├── standalone_minimal.ml ├── standalone_minimal_maximization.ml ├── standalone_minimal.expected ├── simplex.ml ├── standalone_test_strict_bounds.ml └── standalone_minimal_maximization.expected ├── CONTRIBUTING.md ├── Makefile ├── .github └── workflows │ ├── documentation.yml │ └── build.yml ├── extra ├── TODO.txt └── simplex_invariants.txt ├── dune-project ├── ocplib-simplex.opam ├── ocplib-simplex.opam.locked ├── CHANGES.md ├── README.md └── LICENSE /.gitignore: -------------------------------------------------------------------------------- 1 | _opam 2 | _build 3 | .merlin 4 | *.install 5 | 6 | *.swp 7 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name OcplibSimplex) 3 | (public_name ocplib-simplex) 4 | (libraries logs) 5 | (modules_without_implementation coreSig extSigs) 6 | ) 7 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | root = true 2 | 3 | [*] 4 | indent_style = space 5 | indent_size = 2 6 | charset = utf-8 7 | trim_trailing_whitespace = true 8 | insert_final_newline = true 9 | 10 | [Makefile] 11 | indent_style = tab 12 | -------------------------------------------------------------------------------- /tests/standalone_test_strict_bounds.expected: -------------------------------------------------------------------------------- 1 | -+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ 2 | The problem 'max (2) * x + (2) * y' ... 3 | has an upper bound: 18 (is_le = true)(reason: x<=5, y<5) 4 | -+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ 5 | 6 | -------------------------------------------------------------------------------- /tests/solveEmpty.ml: -------------------------------------------------------------------------------- 1 | 2 | open Simplex 3 | 4 | let () = 5 | let sim = Sim.Core.empty ~is_int:false ~check_invs:true in 6 | let sim = Sim.Solve.solve sim in 7 | aux ( 8 | fun fmt () -> 9 | Format.fprintf fmt "\n### Test Solve Empty@." 10 | ) (sim, None) 11 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names 3 | solveEmpty 4 | standalone_minimal_maximization 5 | standalone_minimal 6 | standalone_test_strict_bounds) 7 | (modules 8 | simplex 9 | solveEmpty 10 | standalone_minimal_maximization 11 | standalone_minimal 12 | standalone_test_strict_bounds) 13 | (libraries ocplib-simplex zarith)) 14 | -------------------------------------------------------------------------------- /src/version.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | let version="0.5" 8 | -------------------------------------------------------------------------------- /src/version.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | val version : string 8 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Guide to contributing to Ocplib-simplex 2 | 3 | ## Release Process 4 | 5 | - Make a PR on `master` to initiate the release. The PR must introduce 6 | a new section in `CHANGES.md` with the new version number; 7 | - Once the PR is merged, create a new `vX.Y.Z` branch for the release from the 8 | current `master`. 9 | 10 | ## Make the release 11 | 12 | The release is made using `dune-release`, and follows standard procedure for 13 | the tool: 14 | - `dune-release check` performs basic check; 15 | - `dune-release tag vX.Y.Z` creates a tag on the current branch; 16 | - `dune-release distrib` creates the distribution archive; 17 | - `dune-release publish` publishes the release on GitHub; 18 | - `dune-release opam pkg` creates an archive for opam; 19 | - `dune-release opam submit` opens a PR on the opam repository. 20 | -------------------------------------------------------------------------------- /tests/solveEmpty.expected: -------------------------------------------------------------------------------- 1 | 2 | ### Test Solve Empty 3 | == begin ======================================== 4 | on integers ? false 5 | --- values of non-basic --------------------------- 6 | --------------------------------------------------- 7 | --- values of basic ------------------------------- 8 | --------------------------------------------------- 9 | --- matrix ---------------------------------------- 10 | --------------------------------------------------- 11 | --- sets of uses ---------------------------------- 12 | --------------------------------------------------- 13 | --- basic variables in fixme ---------------------- 14 | (fixme is empty) 15 | --------------------------------------------------- 16 | --- simplex status -------------------------------- 17 | Sat: 18 | 19 | 20 | == end ========================================== 21 | -------------------------------------------------------------------------------- /tests/standalone_minimal.ml: -------------------------------------------------------------------------------- 1 | 2 | open Simplex 3 | 4 | let () = 5 | let sim = Sim.Core.empty ~is_int:true ~check_invs:true in 6 | let zero = Sim.Core.R2.zero in 7 | let m_one = (Sim.Core.R2.of_r Rat.m_one) in 8 | 9 | (* x >= 0 *) 10 | let sim, _ = 11 | Sim.Assert.var sim "x" 12 | ~min:{Sim.Core.bvalue = zero; explanation = Ex.singleton "x>=0"} 13 | in 14 | 15 | (* y >= 0 *) 16 | let sim, _ = 17 | Sim.Assert.var sim "y" 18 | ~min:{Sim.Core.bvalue = zero; explanation = Ex.singleton "y>=0"} 19 | in 20 | let x_y = Sim.Core.P.from_list ["x", Rat.one; "y", Rat.one] in 21 | 22 | (* z == x + y <= -1 *) 23 | let sim, _ = 24 | Sim.Assert.poly sim x_y "z" 25 | ~max:{Sim.Core.bvalue = m_one; explanation = Ex.singleton "x+y<=-1"} 26 | in 27 | let sim = Sim.Solve.solve sim in 28 | 29 | aux ( 30 | fun fmt () -> 31 | Format.fprintf fmt "\n### Test Solve Unsat@." 32 | ) (sim, None) 33 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | build: 3 | @dune build @all @install 4 | 5 | doc: 6 | @dune build @doc 7 | 8 | all: build doc 9 | 10 | clean: 11 | @dune clean 12 | 13 | test: build 14 | @dune runtest --no-buffer -f 15 | 16 | lock: 17 | dune build ./ocplib-simplex.opam 18 | opam lock ./ocplib-simplex.opam -w 19 | # Remove OCaml compiler constraints 20 | sed -i '/"ocaml"\|"ocaml-base-compiler"\|"ocaml-system"\|"ocaml-config"/d' ./ocplib-simplex.opam.locked 21 | 22 | WATCH?= @all 23 | watch: 24 | @dune build $(WATCH) -w 25 | 26 | install: build 27 | @dune install 28 | 29 | uninstall: 30 | @dune uninstall 31 | 32 | reindent: 33 | @find src '(' -name '*.ml' -or -name '*.mli' ')' -print0 | xargs -0 echo "reindenting: " 34 | @find src '(' -name '*.ml' -or -name '*.mli' ')' -print0 | xargs -0 sed -i 's/[[:space:]]*$$//' 35 | @find src '(' -name '*.ml' -or -name '*.mli' ')' -print0 | xargs -0 ocp-indent -i 36 | 37 | opam-deps: 38 | opam install . --deps-only 39 | 40 | .PHONY: build doc all clean test lock watch install uninstall reindent opam-deps 41 | -------------------------------------------------------------------------------- /.github/workflows/documentation.yml: -------------------------------------------------------------------------------- 1 | name: Documentation 2 | 3 | on: 4 | push: 5 | branches: 6 | - master 7 | 8 | env: 9 | OCAML_DEFAULT_VERSION: 5.0.0 10 | OPAMYES: true 11 | 12 | jobs: 13 | build-and-deploy: 14 | runs-on: ubuntu-latest 15 | env: 16 | OPAMWITHDOC: true 17 | 18 | steps: 19 | - name: Checkout 20 | uses: actions/checkout@v4 21 | 22 | - name: Use OCaml ${{ env.OCAML_DEFAULT_VERSION }} 23 | uses: ocaml/setup-ocaml@v2 24 | with: 25 | allow-prerelease-opam: true 26 | ocaml-compiler: ${{ env.OCAML_DEFAULT_VERSION }} 27 | dune-cache: true 28 | 29 | - name: Install dependencies 30 | run: opam install . --deps-only --with-doc 31 | 32 | - name: Make odoc documentation 33 | run: opam exec -- make doc 34 | 35 | - name: Deploy 36 | uses: JamesIves/github-pages-deploy-action@v4 37 | with: 38 | token: ${{ secrets.GITHUB_TOKEN }} 39 | branch: gh-pages 40 | folder: _build/default/_doc/_html/ 41 | -------------------------------------------------------------------------------- /extra/TODO.txt: -------------------------------------------------------------------------------- 1 | global: 2 | ------- 3 | - put some documentation in .mli files 4 | - try some more heuristics to extract models for simplexes over ints. 5 | - add the ability to do some encoding (with a flag): (eg. cubes-test 6 | for LIA) 7 | - add the ability to backtrack by directly relaxing bounds. This would 8 | allow to not rely on the functional style to backtrack, and to keep 9 | the pivots and valuation that have been computed so far 10 | 11 | - add the ability to apply substitutions resulting from pivots 12 | lazily. This is very important for scalability 13 | 14 | - optimization: early detection of unsat if one of the variables in 15 | fixme cannot be fixed 16 | 17 | assertBounds.ml: 18 | ---------------- 19 | 20 | - assert_var and assert_poly should ignore bounds when Pb is UNSAT 21 | 22 | - assert_var and assert_poly should ignore bounds that are implied by 23 | those of the simplex 24 | 25 | - add a mode for assert_var and assert_poly to ignore previously 26 | asserted bounds ? (i.e. mode force_bounds) useful for assertUI.ml ? 27 | 28 | - deduce bounds from the simplex ? 29 | -------------------------------------------------------------------------------- /src/basic.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | open ExtSigs 8 | 9 | module Make 10 | (Var : Variables) 11 | (R : Rationals) 12 | (Ex : Explanations) : sig 13 | 14 | module Core : CoreSig.S 15 | with module Var=Var 16 | and type R.t = R.t 17 | and type V.t = R.t 18 | and module Ex=Ex 19 | 20 | module Assert : AssertBounds.S with module Core := Core 21 | module Solve : SolveBounds.S with module Core := Core 22 | module Result : Result.S with module Core := Core 23 | 24 | end = struct 25 | 26 | module Core = Core.Make(Var)(R)(Ex) 27 | module Assert = AssertBounds.Make(Core) 28 | module Solve = SolveBounds.Make(Core) 29 | module Result = Result.Make(Core) 30 | 31 | end 32 | -------------------------------------------------------------------------------- /tests/standalone_minimal_maximization.ml: -------------------------------------------------------------------------------- 1 | open Simplex 2 | 3 | let large i = Sim.Core.R2.of_r (Q.of_int i) 4 | 5 | let bnd r e = {Sim.Core.bvalue = r; explanation = e} 6 | 7 | let () = 8 | let sim = Sim.Core.empty ~is_int:true ~check_invs:true in 9 | 10 | let x_y = Sim.Core.P.from_list ["x", Rat.one; "y", Rat.one] in 11 | let y1 = Sim.Core.P.from_list ["y", Rat.one] in 12 | let ym1 = Sim.Core.P.from_list ["y", Rat.m_one] in 13 | 14 | (* s == x + y >= 10 15 | let sim = Sim.Assert.poly sim x_y "s" (large 10) Ex.empty None Ex.empty in 16 | *) 17 | 18 | (* x <= 5 *) 19 | let sim, _ = 20 | Sim.Assert.var sim "x" 21 | ~min:(bnd (large 3) (Ex.singleton "x>=3")) 22 | in 23 | 24 | (* s == x + y <= 10 *) 25 | let sim, _ = 26 | Sim.Assert.poly sim x_y "s" 27 | ~max:(bnd (large 10) (Ex.singleton "x+y<=10")) in 28 | 29 | let max_hdr pb fmt () = 30 | Format.fprintf fmt "### Problem 'max %a'@." Sim.Core.P.print pb 31 | in 32 | 33 | aux (max_hdr x_y) (Sim.Solve.maximize sim x_y); 34 | aux (max_hdr y1) (Sim.Solve.maximize sim y1); 35 | aux (max_hdr ym1) (Sim.Solve.maximize sim ym1) 36 | -------------------------------------------------------------------------------- /src/solveBounds.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | val src : Logs.src 8 | 9 | module type S = sig 10 | module Core : CoreSig.S 11 | 12 | val solve : Core.t -> Core.t 13 | (** [solve env] solves the linear inequalities in the simplex [env]. 14 | 15 | Use {!module-Result} to retrieve the solution if any. 16 | *) 17 | 18 | val maximize : Core.t -> Core.P.t -> Core.t * (Core.P.t * bool) option 19 | (** [maximize env objective] finds the maximum value of [objective] that satisfies the system of linear inequalities in [env]. 20 | 21 | Use {!module-Result} to retrieve the solution if any. 22 | 23 | @return env,(objective,is_max_bounded) 24 | *) 25 | end 26 | 27 | module Make(Core : CoreSig.S) : S with module Core = Core 28 | -------------------------------------------------------------------------------- /src/result.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | module type S = sig 8 | module Core : CoreSig.S 9 | val get : (Core.P.t * bool) option -> Core.t -> Core.result 10 | (** [get (objective, is_max_bounded) env] retrieves the result from a simplex [env]. 11 | 12 | This needs to be called after the system [env] has been solved by {!module-SolveBounds}. 13 | 14 | @param objective the optimization objective if any 15 | @param is_max_bounded whether the result is bounded 16 | @param env the simplex environment (system of linear inequalities) containing the solution 17 | 18 | @return solution that satisfies the constraints if any 19 | *) 20 | 21 | 22 | end 23 | 24 | module Make(Core : CoreSig.S) : S with module Core = Core 25 | -------------------------------------------------------------------------------- /src/basic.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | open ExtSigs 8 | 9 | (** The main entry point of the library. 10 | It provides a functor building each key module of OcplibSimplex. *) 11 | 12 | module Make 13 | (Var : Variables)(R : Rationals)(Ex : Explanations) : sig 14 | 15 | (** The core module defines the different data types used by the project 16 | and some functions to handle them. *) 17 | module Core : CoreSig.S 18 | with module Var=Var 19 | and type R.t=R.t 20 | and type V.t = R.t 21 | and module Ex=Ex 22 | 23 | module Assert : AssertBounds.S with module Core := Core 24 | module Solve : SolveBounds.S with module Core := Core 25 | module Result : Result.S with module Core := Core 26 | 27 | end 28 | 29 | -------------------------------------------------------------------------------- /tests/standalone_minimal.expected: -------------------------------------------------------------------------------- 1 | 2 | ### Test Solve Unsat 3 | == begin ======================================== 4 | on integers ? true 5 | --- values of non-basic --------------------------- 6 | 0 <= [ x == 0 ] < +∞ (computed OK ) (flag OK ) 7 | 0 <= [ y == 0 ] < +∞ (computed OK ) (flag OK ) 8 | --------------------------------------------------- 9 | --- values of basic ------------------------------- 10 | --------------------------------------------------- 11 | -∞ < [ z == 0 ] <= -1 (computed KO(Upper)) (flag KO(Upper)) 12 | --- matrix ---------------------------------------- 13 | z = (1) * x + (1) * y 14 | --------------------------------------------------- 15 | --- sets of uses ---------------------------------- 16 | variables that use x are: z, 17 | variables that use y are: z, 18 | --------------------------------------------------- 19 | --- basic variables in fixme ---------------------- 20 | (fixme is empty) 21 | --------------------------------------------------- 22 | --- simplex status -------------------------------- 23 | Unsat:x+y<=-1, x>=0, y>=0 24 | 25 | == end ========================================== 26 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | (generate_opam_files true) 3 | 4 | (name ocplib-simplex) 5 | (version dev) 6 | (source (github OCamlPro/ocplib-simplex)) 7 | (authors 8 | "Mohamed Iguernlala " 9 | "Hichem Ait El Hara " 10 | "Steven de Oliveira " 11 | "Guillaume Bury " 12 | "Pierre Villemot " 13 | ) 14 | (maintainers "OCamlPro ") 15 | (documentation "https://ocamlpro.github.io/ocplib-simplex") 16 | 17 | (package 18 | (name ocplib-simplex) 19 | (synopsis 20 | "A library implementing a simplex algorithm, in a functional style, for solving systems of linear inequalities") 21 | (description 22 | "A (fully) functional OCaml implementation of the simplex algorithm for solving systems of linear inequalities. The implementation is incremental and backtrackable. It is able to extract unsat-cores for unsatisfiable problems. Versions > 0.1 also support linear optimization.") 23 | (license "LGPL-2.1-or-later") 24 | (depends 25 | (ocaml (>= 4.02.0)) 26 | (dune (>= 3.0)) 27 | (ocamlfind (>= 1.9.1)) 28 | (zarith :with-test) 29 | (logs (>= 0.5.0)) 30 | (odoc :with-doc) 31 | )) 32 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: Build 2 | 3 | on: 4 | push: 5 | pull_request: 6 | 7 | permissions: {} 8 | 9 | env: 10 | OCAML_DEFAULT_VERSION: 4.08.1 11 | # Add OPAMYES=true to the environment, this is usefill to replace `-y` option 12 | # in any opam call 13 | OPAMYES: true 14 | 15 | jobs: 16 | build: 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | os: 21 | - macos-latest 22 | - ubuntu-latest 23 | ocaml-compiler: 24 | - 4.08.1 25 | - 5.0.0 26 | 27 | runs-on: ${{ matrix.os }} 28 | 29 | steps: 30 | - name: Checkout 31 | uses: actions/checkout@v4 32 | with: 33 | persist-credentials: true 34 | 35 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 36 | uses: ocaml/setup-ocaml@v2 37 | with: 38 | allow-prerelease-opam: true 39 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 40 | dune-cache: true 41 | 42 | - name: Install dependencies 43 | run: opam exec -- opam install -y . --locked --deps-only --with-test 44 | 45 | - name: Build ocplib-simplex with opam 46 | run: opam exec -- opam reinstall . 47 | 48 | - name: Run tests 49 | run: opam exec -- make test 50 | -------------------------------------------------------------------------------- /src/core.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | open ExtSigs 8 | 9 | val src : Logs.src 10 | 11 | module Make 12 | (Var : Variables) 13 | (R : Rationals) 14 | (Ex : Explanations) 15 | : CoreSig.S 16 | with module Var = Var 17 | and type R.t = R.t 18 | and type V.t = R.t 19 | and module Ex = Ex 20 | 21 | module MakeExpert 22 | (Var : Variables) 23 | (R : Coefs) 24 | (V : Value with type r = R.t) 25 | (Ex : Explanations) 26 | (R2 : Rat2.SIG with module R = R and module V = V) 27 | (P : Polys.SIG with module Var = Var and module R = R) 28 | (MX : MapSig with type key = Var.t) 29 | (SX : SetSig with type elt = Var.t) 30 | : CoreSig.S with module Var=Var and module R=R and module V=V and module Ex=Ex and 31 | module P = P and module MX = MX and module SX = SX 32 | (** Same than Make but allows to choose the implementation of polynomials, maps 33 | and sets *) 34 | -------------------------------------------------------------------------------- /src/polys.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | open ExtSigs 8 | 9 | module type SIG = sig 10 | module Var : Variables 11 | module R : Coefs 12 | 13 | type t 14 | type var_status = New | Exists | Removed 15 | 16 | val empty : t 17 | val is_polynomial : t -> bool 18 | val is_empty : t -> bool 19 | 20 | val replace : Var.t -> R.t -> t -> t * var_status 21 | val accumulate : Var.t -> R.t -> t -> t * var_status 22 | val append : t -> R.t -> t -> t * (Var.t * var_status) list 23 | val subst : Var.t -> t -> t -> t * (Var.t * var_status) list 24 | val from_list : (Var.t * R.t) list -> t 25 | val print : Format.formatter -> t -> unit 26 | 27 | val fold: (Var.t -> R.t -> 'a -> 'a) -> t -> 'a -> 'a 28 | val iter: (Var.t -> R.t -> unit) -> t -> unit 29 | val partition: (Var.t -> R.t -> bool) -> t -> t * t 30 | val compare : t -> t -> int 31 | val mem : Var.t -> t -> bool 32 | val equal : t -> t -> bool 33 | val bindings : t -> (Var.t * R.t) list 34 | val find : Var.t -> t -> R.t 35 | val remove : Var.t -> t -> t 36 | end 37 | 38 | module Make(Var: Variables)(R : Rationals) : SIG 39 | with module Var = Var and module R = R 40 | 41 | -------------------------------------------------------------------------------- /ocplib-simplex.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "dev" 4 | synopsis: 5 | "A library implementing a simplex algorithm, in a functional style, for solving systems of linear inequalities" 6 | description: 7 | "A (fully) functional OCaml implementation of the simplex algorithm for solving systems of linear inequalities. The implementation is incremental and backtrackable. It is able to extract unsat-cores for unsatisfiable problems. Versions > 0.1 also support linear optimization." 8 | maintainer: ["OCamlPro "] 9 | authors: [ 10 | "Mohamed Iguernlala " 11 | "Hichem Ait El Hara " 12 | "Steven de Oliveira " 13 | "Guillaume Bury " 14 | "Pierre Villemot " 15 | ] 16 | license: "LGPL-2.1-or-later" 17 | homepage: "https://github.com/OCamlPro/ocplib-simplex" 18 | doc: "https://ocamlpro.github.io/ocplib-simplex" 19 | bug-reports: "https://github.com/OCamlPro/ocplib-simplex/issues" 20 | depends: [ 21 | "ocaml" {>= "4.02.0"} 22 | "dune" {>= "3.0" & >= "3.0"} 23 | "ocamlfind" {>= "1.9.1"} 24 | "zarith" {with-test} 25 | "logs" {>= "0.5.0"} 26 | "odoc" {with-doc} 27 | ] 28 | build: [ 29 | ["dune" "subst"] {dev} 30 | [ 31 | "dune" 32 | "build" 33 | "-p" 34 | name 35 | "-j" 36 | jobs 37 | "@install" 38 | "@runtest" {with-test} 39 | "@doc" {with-doc} 40 | ] 41 | ] 42 | dev-repo: "git+https://github.com/OCamlPro/ocplib-simplex.git" 43 | -------------------------------------------------------------------------------- /ocplib-simplex.opam.locked: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "ocplib-simplex" 3 | version: "0.5" 4 | synopsis: 5 | "ocplib-simplex: A library implementing a simplex algorithm, in a functional style, for solving systems of linear inequalities" 6 | description: 7 | "ocplib-simplex is a (fully) functional OCaml implementation of the simplex algorithm for solving systems of linear inequalities. The implementation is incremental and backtrackable. It is able to extract unsat-cores for unsatisfiable problems. Versions > 0.1 also support linear optimization." 8 | maintainer: "OCamlPro " 9 | authors: [ 10 | "Mohamed Iguernlala " 11 | "Hichem Ait El Hara " 12 | "Steven de Oliveira " 13 | "Guillaume Bury " 14 | ] 15 | license: "LICENSE" 16 | homepage: "https://github.com/OCamlPro/ocplib-simplex" 17 | doc: "https://github.com/OCamlPro/ocplib-simplex" 18 | bug-reports: "https://github.com/OCamlPro/ocplib-simplex/issues" 19 | depends: [ 20 | "base-bigarray" {= "base"} 21 | "base-threads" {= "base"} 22 | "base-unix" {= "base"} 23 | "conf-gmp" {= "4" & with-test} 24 | "dune" {= "3.14.2"} 25 | "logs" {= "0.7.0"} 26 | "ocamlbuild" {= "0.14.3"} 27 | "ocamlfind" {= "1.9.6"} 28 | "topkg" {= "1.0.7"} 29 | "zarith" {= "1.13" & with-test} 30 | ] 31 | build: [ 32 | ["dune" "subst"] {pinned} 33 | [ 34 | "dune" 35 | "build" 36 | "-p" 37 | name 38 | "-j" 39 | jobs 40 | "@install" 41 | "@runtest" {with-test} 42 | "@doc" {with-doc} 43 | ] 44 | ] 45 | dev-repo: "git+https://github.com/OCamlPro/ocplib-simplex.git" 46 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## unreleased 2 | 3 | ## v0.5.1 (2024-03-28) 4 | * Add documentation for solving system (PR #16). 5 | * Separate types for coefficents and values (PR #17). 6 | * Remove the dependency on `num` (PR #19). 7 | * Remove messages at the `App` level (PR #22). 8 | 9 | ## 0.4.1 (2023-04-21) 10 | * Fix the issue 13 about strict formats (PR #18). 11 | 12 | ## 0.5 (2022-11-15) 13 | * Reworking the library build system, now only relying on dune. 14 | The Makefile is now clearer and simpler to use. 15 | * Logs are handled by the `logs` library and debug is activated by this 16 | library. 17 | * The `Rat2` module now abstract bounds as strict upper, strict lower or 18 | soft bounds instead of pairs of rationals. 19 | 20 | ## 0.4 (2017-08-22) 21 | * Now, asserting bounds returns whether these bounds are 22 | trivially implied by those that are already known 23 | * Add a field nb_pivots in the environment to count the number of 24 | pivots that have been made so far. 25 | 26 | ## 0.3 (2016-11-09) 27 | * Bugfix in maximization 28 | 29 | ## 0.2 (2016-08-24) 30 | * Add support for linear optimization (!!!). An minimal example is given 31 | in tests/standalone_minimal_maximization.ml 32 | * Some bugfixes when assuming inconsistent bounds 33 | * Improve build and testing 34 | 35 | ## 0.1 (2016-07-11) 36 | * A functor called `Basic` provides three modules: 37 | - `Core`: provides some basic functions, and a function `empty` to 38 | create an empty environment 39 | - `Assert`: exports two functions `var` and `polys` to assert bounds 40 | on variables and polynomials, respectively 41 | - `Solve`: exports a function `solve` that tries to find a solution for 42 | the constrains 43 | * Two flags can be set when creating an empty environment to activate 44 | debug mode and some invariants verification 45 | * Implementation is fully functional, incremental and backtrackable 46 | * Linear optimization is not supported yet 47 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Ocplib-simplex 2 | 3 | `Ocplib-simplex` a is library implementing a simplex algorithm, in a functional 4 | style, for solving systems of linear inequalities and optimizing linear 5 | objective functions. The implementation is incremental and backtrackable. 6 | It is able to extract unsat-cores for unsatisfiable problems. Versions `> 0.1` 7 | also support linear optimization. 8 | 9 | ## Website 10 | 11 | Ocplib-simplex's web is available at: https://ocamlpro.github.io/ocplib-simplex 12 | 13 | ## Dependencies 14 | 15 | `ocplib-simplex` requires `4.08.1` or higher and `ocamlfind`. 16 | You can use `make opam-deps` to install dependencies in the current switch. 17 | 18 | 19 | ## Build and Install Instructions 20 | 21 | The easiest way to install ocplib-simplex is to use OPAM: 22 | 23 | $ opam install ocplib-simplex 24 | 25 | If you want to install ocplib-simplex from sources, use the following 26 | instructions: 27 | 28 | $ make opam-deps (if you are using OPAM and some deps are missing) 29 | $ make 30 | $ make install 31 | 32 | to compile and install `ocplib-simplex` on your system. You can 33 | uninstall the library with `make uninstall`. 34 | 35 | 36 | ## Minimal Examples 37 | 38 | Solving a system of linear inequalities: see the file `tests/standalone_minimal.ml` 39 | 40 | Linear optimization: see the file `tests/standalone_minimal_maximization.ml` 41 | 42 | ## Contributing 43 | 44 | Don't hesitate to report encountered bugs on this Git repo's issues 45 | tracker. Please follow the [contribution guide][contributing]. 46 | 47 | ## TODO 48 | 49 | - the code is not (well) documented, 50 | 51 | - some parts of the code need factorization/simplification, 52 | 53 | - some invariants (check unsat-core, linear optimization) are missing. 54 | 55 | 56 | ## Licensing 57 | 58 | `ocplib-simplex` is Copyright (C) --- OCamlPro. it is distributed 59 | under the terms of the GNU Lesser General Public License (LGPL) 60 | version 2.1 (see LICENSE file for more details). 61 | -------------------------------------------------------------------------------- /tests/simplex.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | module Var = struct 8 | type t = string 9 | 10 | let print fmt s = Format.fprintf fmt "%s" s 11 | 12 | let compare = String.compare 13 | 14 | let is_int _ = true 15 | end 16 | 17 | module Rat = struct 18 | type t = Q.t 19 | let add = Q.add 20 | let minus = Q.neg 21 | let mult = Q.mul 22 | let abs = Q.abs 23 | let compare = Q.compare 24 | let equal = Q.equal 25 | let zero = Q.zero 26 | let one = Q.one 27 | let m_one = Q.minus_one 28 | let is_zero n = Q.equal n Q.zero 29 | let to_string = Q.to_string 30 | 31 | let print = Q.pp_print 32 | let is_int v = Z.equal (Q.den v) Z.one 33 | let div = Q.div 34 | let sub = Q.sub 35 | let is_one v = Q.equal v Q.one 36 | let is_m_one v = Q.equal v Q.minus_one 37 | let sign = Q.sign 38 | let min = Q.min 39 | 40 | let floor v = Z.fdiv (Q.num v) (Q.den v) |> Q.of_bigint 41 | let ceiling v = Z.cdiv (Q.num v) (Q.den v) |> Q.of_bigint 42 | 43 | end 44 | 45 | module Ex = struct 46 | include Set.Make(String) 47 | 48 | let print fmt s = match elements s with 49 | | [] -> Format.fprintf fmt "()" 50 | | e::l -> 51 | Format.fprintf fmt "%s" e; 52 | List.iter (Format.fprintf fmt ", %s") l 53 | end 54 | 55 | module Ty = OcplibSimplex.Core.Make(Var)(Rat)(Ex) 56 | module AB = OcplibSimplex.AssertBounds.Make(Ty) 57 | 58 | module Sim = OcplibSimplex.Basic.Make(Var)(Rat)(Ex) 59 | 60 | let aux header (sim, opt) = 61 | Format.printf "%a" header (); 62 | Format.printf "%a" 63 | (Sim.Core.print (Sim.Result.get opt sim)) sim 64 | 65 | let () = 66 | Logs.Src.set_level OcplibSimplex.Core.src (Some Debug); 67 | Logs.Src.set_level OcplibSimplex.SolveBounds.src (Some Debug) 68 | -------------------------------------------------------------------------------- /src/assertBounds.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | module type S = sig 8 | 9 | module Core : CoreSig.S 10 | 11 | (* The returned bool is [true] if the asserted bounds are not trivial 12 | (i.e. not implied by known bounds) *) 13 | (** [var env min max x] returns a new environment obtained by changing 14 | the bounds of [x] in [env] to [min] and [max]. 15 | If the bounds were implied by other known bounds (in other words, if the 16 | environment did not change) the associated boolean will be [false]. 17 | *) 18 | val var : 19 | Core.t -> 20 | ?min:Core.bound -> 21 | ?max:Core.bound -> 22 | Core.Var.t -> 23 | Core.t * bool 24 | 25 | (** [poly env poly min max x] returns a new environment obtained by changing 26 | the bounds of [poly] in [env] to [min] and [max]. 27 | The polynomial is represented by the slack variable [x]. 28 | 29 | [poly] must be a polynomial (as tested by [Core.P.is_polynomial]), that 30 | is, it must contain at least two distinct variables. Use [var] instead 31 | for constraints that apply to a single variable. 32 | 33 | The returned bool is [true] if the asserted bounds are not trivial (i.e. 34 | not implied by known bounds). If the bounds were implied by other known 35 | bounds (in other words, if the environment did not change) the associated 36 | boolean will be [false]. 37 | 38 | @raise Invalid_argument if [poly] contains zero or one variables (use [var] 39 | to add constraints to a single variable). 40 | *) 41 | val poly : 42 | Core.t -> 43 | Core.P.t -> 44 | ?min:Core.bound -> 45 | ?max:Core.bound -> 46 | Core.Var.t -> 47 | Core.t * bool 48 | 49 | end 50 | 51 | module Make(Core : CoreSig.S) : S with module Core = Core 52 | -------------------------------------------------------------------------------- /tests/standalone_test_strict_bounds.ml: -------------------------------------------------------------------------------- 1 | open Simplex 2 | 3 | let sep () = 4 | Format.printf "-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+@." 5 | 6 | let pp_epsilon fmt (max_v, eps) = 7 | let pp = 8 | if Sim.Core.R2.is_pure_rational max_v.Sim.Core.bvalue 9 | then Format.ifprintf 10 | else Format.fprintf 11 | in 12 | pp fmt "(epsilon: %a)" Rat.print eps 13 | 14 | let aux sim opt_p = 15 | let sim, opt = Sim.Solve.maximize sim opt_p in 16 | sep (); 17 | Format.printf "The problem 'max %a' ...@." Sim.Core.P.print opt_p; 18 | begin 19 | match Sim.Result.get opt sim with 20 | | Sim.Core.Unknown -> assert false 21 | | Sim.Core.Sat _ -> assert false 22 | 23 | | Sim.Core.Unsat ex -> 24 | Format.printf " is unsat (reason = %a)@." Ex.print (Lazy.force ex); 25 | 26 | | Sim.Core.Unbounded _ -> Format.printf " is unbounded@." 27 | 28 | | Sim.Core.Max (mx,sol) -> 29 | let {Sim.Core.max_v; is_le} = Lazy.force mx in 30 | let sol = Lazy.force sol in 31 | Format.printf 32 | " has an upper bound: %a (is_le = %b)(reason: %a)%a@." 33 | Sim.Core.R2.print max_v.Sim.Core.bvalue 34 | is_le 35 | Ex.print max_v.Sim.Core.explanation 36 | pp_epsilon (max_v, sol.Sim.Core.epsilon) 37 | ; 38 | end; 39 | sep (); 40 | Format.printf "@." 41 | 42 | let large i = Sim.Core.R2.of_r (Q.of_int i) 43 | let upper i = Sim.Core.R2.upper (Q.of_int i) 44 | let lower i = Sim.Core.R2.lower (Q.of_int i) 45 | 46 | let bnd r e = {Sim.Core.bvalue = r; explanation = e} 47 | 48 | let r_two = Rat.add Rat.one Rat.one 49 | 50 | let () = 51 | let sim = Sim.Core.empty ~is_int:true ~check_invs:false in 52 | 53 | let x_m_y = Sim.Core.P.from_list ["x", Rat.one; "y", Rat.m_one] in 54 | let tx_ty = Sim.Core.P.from_list ["x", r_two; "y", r_two] in 55 | 56 | (* 3 < y < 5*) 57 | let sim, _ = 58 | Sim.Assert.var sim "y" 59 | ~min:(bnd (lower 3) (Ex.singleton "y>3")) 60 | ~max:(bnd (upper 5) (Ex.singleton "y<5")) 61 | in 62 | 63 | (* 3 < x < 4 *) 64 | let sim, _ = 65 | Sim.Assert.var sim "x" 66 | ~min:(bnd (lower 3) (Ex.singleton "x>3")) 67 | ~max:(bnd (large 5) (Ex.singleton "x<=5")) 68 | in 69 | 70 | (* 0 <= x - y *) 71 | let sim, _ = 72 | Sim.Assert.poly sim x_m_y "s'" 73 | ~min:(bnd (large 1) (Ex.singleton "x-y>=1")) 74 | in 75 | 76 | (* s == 2x + 2y <= 20 *) 77 | let sim, _ = 78 | Sim.Assert.poly sim tx_ty "s" 79 | ~max:(bnd (large 20) (Ex.singleton "2x+2y<=20")) in 80 | 81 | aux sim tx_ty 82 | -------------------------------------------------------------------------------- /src/rat2.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | (** A representation of rationals bound, which is a pair of rationals: 8 | - the raw value of the bound 9 | - an epsilon used as an offset for representing strict bounds. 10 | 11 | For example, for the inequality [x < 3], the upper bound of [x] will 12 | be represented by [3 - Ɛ], where [Ɛ] is a positive integer that will 13 | be calculated later. 14 | *) 15 | 16 | open ExtSigs 17 | 18 | module type SIG = sig 19 | module R : Coefs 20 | module V : Value with type r = R.t 21 | 22 | (** {1 Type} *) 23 | 24 | type t = private { 25 | v: V.t; 26 | (** The raw value of the bound. *) 27 | 28 | offset: R.t 29 | (** The number of epsilons to add to the bound. *) 30 | } 31 | 32 | (** {1 Constructors} *) 33 | 34 | (** The zero bound with no offset. *) 35 | val zero : t 36 | 37 | (** From a rational [r], returns the Rat2 representation with no offset. *) 38 | val of_r : V.t -> t 39 | 40 | (** From a rational [r], returns [r - Ɛ]. *) 41 | val upper : V.t -> t 42 | 43 | (** From a rational [r], returns [r + Ɛ]. *) 44 | val lower : V.t -> t 45 | 46 | (** {1 Algebraic operations} *) 47 | 48 | (** From a bound [r + kƐ], returns [-r -kƐ]. *) 49 | val minus : t -> t 50 | 51 | (** Adds two bounds. *) 52 | val add : t -> t -> t 53 | 54 | (** Substracts two bounds. *) 55 | val sub : t -> t -> t 56 | 57 | (** Multiplies a bound by a rational constant 58 | (both v and offset are multiplied). *) 59 | val mult_by_const : R.t -> t -> t 60 | 61 | (** Divides a bound by a constant. Fails if the constant is zero. *) 62 | val div_by_const : R.t -> t -> t 63 | 64 | (** {1 Comparison functions} *) 65 | 66 | (** Compares two bounds; returns 0 iff the two bounds are strictly equal. *) 67 | val compare : t -> t -> int 68 | 69 | (** Returns [true] iff the bounds are strictly equal. *) 70 | val equal : t -> t -> bool 71 | 72 | (** Returns [true] iff the bound in argument is zero. *) 73 | val is_zero : t -> bool 74 | 75 | (** Returns [true] iff the offset is 0. *) 76 | val is_pure_rational : t -> bool 77 | 78 | (** Returns [true] iff the offset is 0 and the field [v] is an integer. *) 79 | val is_int : t -> bool 80 | 81 | (** {1 Misc} *) 82 | 83 | (** Returns the greatest (pure) integer smaller or equal to the argument. *) 84 | val floor : t -> t 85 | 86 | (** Returns the smallest (pure) integer greater or equal to the argument. *) 87 | val ceiling : t -> t 88 | 89 | (** Prints a bound. *) 90 | val print : Format.formatter -> t -> unit 91 | end 92 | 93 | module Make(R : Rationals)(V : Value with type r = R.t) : SIG with module R = R and module V = V 94 | -------------------------------------------------------------------------------- /extra/simplex_invariants.txt: -------------------------------------------------------------------------------- 1 | Basic formulation: 2 | ---------------- 3 | version 0.1 has the following env. 4 | 5 | type value_status = ValueOK | LowerKO | UpperKO 6 | 7 | type var_info = 8 | { 9 | mini : bound; 10 | maxi : bound; 11 | min_ex : Ex.t; 12 | max_ex : Ex.t; 13 | value : R.t * R.t; 14 | vstatus : value_status; 15 | is_slake : bool; 16 | } 17 | 18 | type t = 19 | { 20 | basic : (var_info * P.t) MX.t; 21 | non_basic : (var_info * SX.t) MX.t; 22 | slake_cache : Var.t SLAKE.t; 23 | fixme : SX.t; 24 | is_int : bool; 25 | status : simplex_status; 26 | debug : int; 27 | check_invariants : bool 28 | } 29 | 30 | (1) 31 | forall x in basic U non_basic U used_by U polys(basic) U 32 | slake_cache U polys(slake_cache) U fixeme. 33 | is_int <=> Var.is_int x 34 | 35 | (2) basic intersect non_basic = empty 36 | 37 | (3) forall p in polys(basic) U polys(slake_cache). 38 | forall (x, c) in p. 39 | (x in basic xor x in non_basic) 40 | and c <> 0 41 | 42 | (4) used_by intersect non_basic = empty 43 | 44 | (5) forall y. forall x in used_by(y). (*y is no_basic and x is basic*) 45 | let _, p = basic(x) 46 | y in vars(p) (* i.e. with a coef != 0 *) 47 | 48 | (6) forall s. forall p such that basic(s) = _, p. 49 | forall x in vars(p). s in used_by(x) 50 | 51 | (* 5 and 6 mean that used_by contain exactly what needed *) 52 | 53 | (7) forall x in non_basic. 54 | min_bound <= val(x) <= max_bound 55 | 56 | 57 | (8) status = SAT => 58 | forall x in basic. 59 | min_bound <= val(x) <= max_bound 60 | 61 | (9) status = IntSAT => 62 | (8) and forall x. val(x) is an integer 63 | 64 | (10) is_int => (* ie simplex on integers *) 65 | coefs of delta_i's in min and max bounds are equal to zero 66 | 67 | (11) not is_int => (* ie simplex on rationnals *) 68 | coefs of delta_i's in min bounds are in {0, 1} and 69 | coefs of delta_i's in max bounds are in {0, -1} 70 | 71 | (12) status = SAT (sol) => 72 | sol satisfies the bounds of every constraints and 73 | sol satisfies every equality s = p, with (s, p) in basic. 74 | 75 | (13) status = UNSAT ({x_i, ex_i)} => 76 | /\ min_bound_i <= x_i <= max_bound_i in UNSAT on 77 | rationnals (* use FM to check this ? *) 78 | 79 | (14). fixme subset basic 80 | 81 | (15) forall x. 82 | x in fixme => 83 | ( val(x) < min_bound_x or 84 | val(x) > max_bound_x ) 85 | 86 | (16) status != UNSAT => 87 | forall x. x not in fixme => min_bound_x <= val(x) <= max_bound_x 88 | 89 | (17) status != Unknown => fixme = empty 90 | (* When UNSAT is deduced, we empty fixme *) 91 | 92 | (18) forall (s, p) in basic. 93 | val(s) = eval(p) 94 | 95 | (19) forall (x, i) in basic U non_basic 96 | min_bound_x <= val(x) <= max_bound_x => i.vstatus = ValueOK) and 97 | val(x) < min_bound_x => i.vstatus = LowerKO and 98 | max_bound_x < val(x) => i.vstatus = UpperKO 99 | 100 | 101 | (20) 102 | status != Unsat => 103 | forall (x, i) in basic U non_basic 104 | (min_bound_x <= max_bound_x) 105 | -------------------------------------------------------------------------------- /src/rat2.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | open ExtSigs 8 | 9 | module type SIG = sig 10 | module R : Coefs 11 | module V : Value with type r = R.t 12 | 13 | type t = private {v: V.t; offset: R.t} 14 | 15 | val zero : t 16 | val of_r : V.t -> t 17 | val upper : V.t -> t 18 | val lower : V.t -> t 19 | 20 | val minus : t -> t 21 | val add : t -> t -> t 22 | val sub : t -> t -> t 23 | val mult_by_const : R.t -> t -> t 24 | val div_by_const : R.t -> t -> t 25 | 26 | val compare : t -> t -> int 27 | val equal : t -> t -> bool 28 | val is_zero : t -> bool 29 | val is_pure_rational : t -> bool 30 | val is_int : t -> bool 31 | 32 | val floor : t -> t 33 | val ceiling : t -> t 34 | 35 | val print : Format.formatter -> t -> unit 36 | end 37 | 38 | module Make(R : Rationals)(V : Value with type r = R.t) 39 | : SIG with module R = R and module V = V = struct 40 | 41 | module R = R 42 | module V = V 43 | 44 | type t = { 45 | v: V.t; 46 | 47 | offset: R.t; 48 | (* When working on strict bounds, an epsilon is added to the bounds. 49 | The offset represents the amount of epsilon are added. *) 50 | } 51 | 52 | let of_r v = {v; offset = R.zero} 53 | let upper v = {v; offset = R.m_one} 54 | let lower v = {v; offset = R.one} 55 | let zero = of_r V.zero 56 | 57 | let is_pure_rational r = R.equal r.offset R.zero 58 | let is_int r = is_pure_rational r && V.is_int r.v 59 | 60 | let map f g a = {v = f a.v; offset = g a.offset} 61 | let map2 f g a b = {v = f a.v b.v; offset = g a.offset b.offset} 62 | 63 | let add = map2 V.add R.add 64 | let sub = map2 V.sub R.sub 65 | 66 | let mult_by_const c e = 67 | if R.is_one c then e 68 | else map (fun v -> V.mult_by_coef v c) (fun v -> R.mult v c) e 69 | 70 | let div_by_const c e = 71 | if R.is_one c then e 72 | else map (fun v -> V.div_by_coef v c) (fun v -> R.div v c) e 73 | 74 | let compare a b = 75 | let c = V.compare a.v b.v in 76 | if c <> 0 then c else R.compare a.offset b.offset 77 | 78 | let equal a b = compare a b = 0 79 | 80 | let is_zero a = V.is_zero a.v && R.is_zero a.offset 81 | 82 | let minus = map V.minus R.minus 83 | 84 | let floor r = 85 | if V.is_int r.v 86 | then 87 | if is_pure_rational r 88 | then r 89 | else of_r (V.sub r.v V.one) 90 | else of_r (V.floor r.v) 91 | 92 | let ceiling r = 93 | if V.is_int r.v 94 | then 95 | if is_pure_rational r 96 | then r 97 | else of_r (V.add r.v V.one) 98 | else of_r (V.ceiling r.v) 99 | 100 | let print_offset fmt off = 101 | let c = R.compare off R.zero in 102 | if c = 0 then () 103 | else if c > 0 104 | then Format.fprintf fmt "+%aƐ" R.print off 105 | else Format.fprintf fmt "%aƐ" R.print off 106 | 107 | let print fmt r = Format.fprintf fmt "%a%a" 108 | V.print r.v 109 | print_offset r.offset 110 | end 111 | -------------------------------------------------------------------------------- /tests/standalone_minimal_maximization.expected: -------------------------------------------------------------------------------- 1 | ### Problem 'max (1) * x + (1) * y' 2 | == begin ======================================== 3 | on integers ? true 4 | --- values of non-basic --------------------------- 5 | -∞ < [ s == 10 ] <= 10 (computed OK ) (flag OK ) 6 | -∞ < [ y == 0 ] < +∞ (computed OK ) (flag OK ) 7 | --------------------------------------------------- 8 | --- values of basic ------------------------------- 9 | --------------------------------------------------- 10 | 3 <= [ x == 10 ] < +∞ (computed OK ) (flag OK ) 11 | --- matrix ---------------------------------------- 12 | x = (1) * s + (-1) * y 13 | --------------------------------------------------- 14 | --- sets of uses ---------------------------------- 15 | variables that use s are: x, 16 | variables that use y are: x, 17 | --------------------------------------------------- 18 | --- basic variables in fixme ---------------------- 19 | (fixme is empty) 20 | --------------------------------------------------- 21 | --- simplex status -------------------------------- 22 | Max: (v=10, is_le=true, ex=x+y<=10) 23 | (int solution ? true) 24 | x --> 10 25 | y --> 0 26 | s --> 10 27 | 28 | 29 | == end ========================================== 30 | ### Problem 'max (1) * y' 31 | == begin ======================================== 32 | on integers ? true 33 | --- values of non-basic --------------------------- 34 | -∞ < [ s == 10 ] <= 10 (computed OK ) (flag OK ) 35 | 3 <= [ x == 3 ] < +∞ (computed OK ) (flag OK ) 36 | --------------------------------------------------- 37 | --- values of basic ------------------------------- 38 | --------------------------------------------------- 39 | -∞ < [ y == 7 ] < +∞ (computed OK ) (flag OK ) 40 | --- matrix ---------------------------------------- 41 | y = (1) * s + (-1) * x 42 | --------------------------------------------------- 43 | --- sets of uses ---------------------------------- 44 | variables that use s are: y, 45 | variables that use x are: y, 46 | --------------------------------------------------- 47 | --- basic variables in fixme ---------------------- 48 | (fixme is empty) 49 | --------------------------------------------------- 50 | --- simplex status -------------------------------- 51 | Max: (v=7, is_le=true, ex=x+y<=10, x>=3) 52 | (int solution ? true) 53 | y --> 7 54 | x --> 3 55 | s --> 10 56 | 57 | 58 | == end ========================================== 59 | ### Problem 'max (-1) * y' 60 | == begin ======================================== 61 | on integers ? true 62 | --- values of non-basic --------------------------- 63 | 3 <= [ x == 3 ] < +∞ (computed OK ) (flag OK ) 64 | -∞ < [ y == 0 ] < +∞ (computed OK ) (flag OK ) 65 | --------------------------------------------------- 66 | --- values of basic ------------------------------- 67 | --------------------------------------------------- 68 | -∞ < [ s == 3 ] <= 10 (computed OK ) (flag OK ) 69 | --- matrix ---------------------------------------- 70 | s = (1) * x + (1) * y 71 | --------------------------------------------------- 72 | --- sets of uses ---------------------------------- 73 | variables that use x are: s, 74 | variables that use y are: s, 75 | --------------------------------------------------- 76 | --- basic variables in fixme ---------------------- 77 | (fixme is empty) 78 | --------------------------------------------------- 79 | --- simplex status -------------------------------- 80 | Unbounded: 81 | (int solution ? true) 82 | y --> 0 83 | x --> 3 84 | s --> 3 85 | 86 | 87 | == end ========================================== 88 | -------------------------------------------------------------------------------- /src/polys.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | open ExtSigs 8 | 9 | module type SIG = sig 10 | module Var : Variables 11 | module R : Coefs 12 | 13 | type t 14 | type var_status = New | Exists | Removed 15 | 16 | val empty : t 17 | val is_polynomial : t -> bool 18 | val is_empty : t -> bool 19 | 20 | val replace : Var.t -> R.t -> t -> t * var_status 21 | val accumulate : Var.t -> R.t -> t -> t * var_status 22 | val append : t -> R.t -> t -> t * (Var.t * var_status) list 23 | val subst : Var.t -> t -> t -> t * (Var.t * var_status) list 24 | val from_list : (Var.t * R.t) list -> t 25 | val print : Format.formatter -> t -> unit 26 | 27 | val fold: (Var.t -> R.t -> 'a -> 'a) -> t -> 'a -> 'a 28 | val iter: (Var.t -> R.t -> unit) -> t -> unit 29 | val partition: (Var.t -> R.t -> bool) -> t -> t * t 30 | val compare : t -> t -> int 31 | val mem : Var.t -> t -> bool 32 | val equal : t -> t -> bool 33 | val bindings : t -> (Var.t * R.t) list 34 | val find : Var.t -> t -> R.t 35 | val remove : Var.t -> t -> t 36 | end 37 | 38 | module Make(Var: Variables)(R : Rationals) : SIG 39 | with module Var = Var and module R = R = struct 40 | 41 | module Var = Var 42 | module R = R 43 | 44 | module MV = Map.Make(Var) 45 | 46 | type t = R.t MV.t 47 | 48 | type var_status = New | Exists | Removed 49 | 50 | let empty = MV.empty 51 | let fold = MV.fold 52 | let iter = MV.iter 53 | let compare = MV.compare R.compare 54 | let partition = MV.partition 55 | 56 | let remove = MV.remove 57 | let find = MV.find 58 | let bindings = MV.bindings 59 | let equal = MV.equal R.equal 60 | let mem = MV.mem 61 | let is_empty = MV.is_empty 62 | 63 | let is_polynomial p = 64 | try 65 | let cpt = ref 0 in 66 | iter (fun _ _ -> incr cpt; if !cpt > 1 then raise Exit) p; 67 | false 68 | with Exit -> 69 | true 70 | 71 | let replace v q t = 72 | if R.is_zero q then MV.remove v t, Removed 73 | else MV.add v q t, (if MV.mem v t then Exists else New) 74 | 75 | let accumulate v q t = 76 | let new_q = try R.add q (find v t) with Not_found -> q in 77 | replace v new_q t 78 | 79 | (* TODO: We can maybe replace mp with a list, since keys are unique ... *) 80 | let append_aux p coef q = 81 | fold (fun x c (p, mp) -> 82 | let p, x_status = accumulate x (R.mult coef c) p in 83 | p, MV.add x x_status mp 84 | ) q (p, MV.empty) 85 | 86 | let append p coef q = 87 | let p, mp = append_aux p coef q in p, MV.bindings mp 88 | 89 | let subst v p q = 90 | try 91 | let new_q, modified = append_aux (remove v q) (find v q) p in 92 | new_q, MV.bindings (MV.add v Removed modified) 93 | with Not_found -> 94 | (* This will oblige us to enforce strong invariants !! 95 | We should know exactly where we have to substitute !! *) 96 | assert false 97 | 98 | let from_list l = 99 | List.fold_left (fun p (x, c) -> fst (accumulate x c p)) empty l 100 | 101 | let print fmt p = 102 | let l = MV.bindings p in 103 | match l with 104 | | [] -> Format.fprintf fmt "(empty-poly)" 105 | | (x, q)::l -> 106 | Format.fprintf fmt "(%a) * %a" R.print q Var.print x; 107 | List.iter 108 | (fun (x,q) -> 109 | Format.fprintf fmt " + (%a) * %a" R.print q Var.print x) l 110 | 111 | end 112 | -------------------------------------------------------------------------------- /src/extSigs.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | 8 | (*----------------------------------------------------------------------------*) 9 | 10 | (** Interface required for variables *) 11 | module type Variables = sig 12 | 13 | (** type of variables used in the simplex *) 14 | type t 15 | 16 | (** compare function on vars *) 17 | val compare : t -> t -> int 18 | 19 | (** [is_int v] returns true if the variable has integer type, 20 | and false otherwise *) 21 | val is_int : t -> bool 22 | 23 | (** [print fmt v] prints the given var *) 24 | val print : Format.formatter -> t -> unit 25 | 26 | end 27 | 28 | (*----------------------------------------------------------------------------*) 29 | 30 | (** Interface required for rationnals *) 31 | module type Rationals = sig 32 | 33 | (** type of rationnal numbers *) 34 | type t 35 | val zero : t 36 | val one : t 37 | val m_one : t 38 | val sign : t -> int (* can be used to quickly compare with zero *) 39 | val compare : t -> t -> int 40 | val equal : t -> t -> bool 41 | val is_zero : t -> bool 42 | val is_one : t -> bool 43 | val is_m_one : t -> bool 44 | val add : t -> t -> t 45 | val sub : t -> t -> t 46 | val div : t -> t -> t 47 | val mult : t -> t -> t 48 | val abs : t -> t 49 | val is_int : t -> bool 50 | val print : Format.formatter -> t -> unit 51 | val to_string : t -> string 52 | val min : t -> t -> t 53 | val minus : t -> t 54 | val floor : t -> t 55 | val ceiling : t -> t 56 | end 57 | 58 | (** Interface required for coefs *) 59 | module type Coefs = sig 60 | 61 | (** type of rationnal numbers *) 62 | type t 63 | val zero : t 64 | val one : t 65 | val m_one : t 66 | val sign : t -> int (* can be used to quickly compare with zero *) 67 | val compare : t -> t -> int 68 | val equal : t -> t -> bool 69 | val is_zero : t -> bool 70 | val is_one : t -> bool 71 | val is_m_one : t -> bool 72 | val add : t -> t -> t 73 | val sub : t -> t -> t 74 | val div : t -> t -> t 75 | val mult : t -> t -> t 76 | val abs : t -> t 77 | val is_int : t -> bool 78 | val print : Format.formatter -> t -> unit 79 | val to_string : t -> string 80 | val min : t -> t -> t 81 | val minus : t -> t 82 | end 83 | 84 | (** Interface required for bounds and solutions *) 85 | module type Value = sig 86 | 87 | (** type of rationnal numbers *) 88 | type t 89 | val zero : t 90 | val one : t 91 | val m_one : t 92 | val sign : t -> int (* can be used to quickly compare with zero *) 93 | val compare : t -> t -> int 94 | val equal : t -> t -> bool 95 | val is_zero : t -> bool 96 | val add : t -> t -> t 97 | val sub : t -> t -> t 98 | val is_int : t -> bool 99 | val print : Format.formatter -> t -> unit 100 | val to_string : t -> string 101 | val min : t -> t -> t 102 | val minus : t -> t 103 | val floor : t -> t 104 | val ceiling : t -> t 105 | 106 | type r 107 | val mult_by_coef: t -> r -> t 108 | val div_by_coef: t -> r -> t 109 | end 110 | 111 | (*----------------------------------------------------------------------------*) 112 | 113 | (** Interface of explanations *) 114 | module type Explanations = sig 115 | type t 116 | val empty : t 117 | val union : t -> t -> t 118 | val print : Format.formatter -> t -> unit 119 | end 120 | 121 | module type MapSig = sig 122 | type 'a t 123 | type key 124 | 125 | val empty : 'a t 126 | val find : key -> 'a t -> 'a 127 | val add : key -> 'a -> 'a t -> 'a t 128 | val remove : key -> 'a t -> 'a t 129 | val mem: key -> 'a t -> bool 130 | val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b 131 | val iter : (key -> 'a -> unit) -> 'a t -> unit 132 | val cardinal : 'a t -> int 133 | end 134 | 135 | module type SetSig = sig 136 | type t 137 | type elt 138 | 139 | val empty : t 140 | val is_empty : t -> bool 141 | val choose : t -> elt 142 | val elements : t -> elt list 143 | val add : elt -> t -> t 144 | val mem : elt -> t -> bool 145 | val remove : elt -> t -> t 146 | val fold : (elt -> 'b -> 'b) -> t -> 'b -> 'b 147 | val iter : (elt -> unit) -> t -> unit 148 | val union : t -> t -> t 149 | end 150 | -------------------------------------------------------------------------------- /src/result.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | module type S = sig 8 | module Core : CoreSig.S 9 | val get : (Core.P.t * bool) option -> Core.t -> Core.result 10 | end 11 | 12 | module Make(Core : CoreSig.S) : S with module Core = Core = struct 13 | 14 | module Core = Core 15 | open Core 16 | 17 | let explain_poly non_basic p ex is_lower = 18 | let invert_sign = if is_lower then 1 else -1 in 19 | P.fold 20 | (fun x coef ex -> 21 | let c = invert_sign * R.sign coef in 22 | assert (c <> 0); 23 | let xi, _ = try MX.find x non_basic with Not_found -> assert false in 24 | let ex, optimum = 25 | if c > 0 then Ex.union ex (Core.expl_of_max_bound xi), xi.maxi 26 | else Ex.union ex (Core.expl_of_min_bound xi), xi.mini 27 | in 28 | assert (equals_optimum xi.value optimum); 29 | ex 30 | )p ex 31 | 32 | let get_unsat_core s env = 33 | try 34 | let si, p = MX.find s env.basic in 35 | if not (consistent_bounds si) 36 | then Ex.union 37 | (Core.expl_of_min_bound si) 38 | (Core.expl_of_max_bound si) 39 | else match si.vstatus with 40 | | ValueOK -> assert false 41 | | LowerKO -> explain_poly env.non_basic p (Core.expl_of_min_bound si) true 42 | | UpperKO -> explain_poly env.non_basic p (Core.expl_of_max_bound si) false 43 | with Not_found -> 44 | let si, _ = MX.find s env.non_basic in 45 | assert (not (consistent_bounds si)); 46 | Ex.union 47 | (Core.expl_of_min_bound si) 48 | (Core.expl_of_max_bound si) 49 | 50 | let get_int_solution env = 51 | let is_int_sol = ref true in 52 | let sol = 53 | MX.fold (fun x (xi,_) sol -> 54 | let v = xi.value in 55 | assert (R2.is_pure_rational v); 56 | is_int_sol := !is_int_sol && V.is_int v.R2.v; 57 | (x, v.R2.v) :: sol 58 | ) env.non_basic [] 59 | in 60 | let sol = 61 | MX.fold (fun x (xi, _) sol -> 62 | let v = xi.value in 63 | assert (R2.is_pure_rational v); 64 | is_int_sol := !is_int_sol && V.is_int v.R2.v; 65 | (x, v.R2.v) :: sol 66 | )env.basic sol 67 | in 68 | let slake = env.slake in 69 | let sol_slk, sol = List.partition (fun (x, _) -> MX.mem x slake) sol in 70 | { main_vars = sol; slake_vars = sol_slk; int_sol = !is_int_sol; epsilon = V.zero} 71 | 72 | 73 | 74 | let eval_eps 75 | (eps : V.t) 76 | (inf : R2.t) 77 | (sup : R2.t) = 78 | let {R2.v = inf_r; offset = inf_d} : R2.t = inf in 79 | let {R2.v = sup_r; offset = sup_d} : R2.t = sup in 80 | let c = V.compare inf_r sup_r in 81 | assert (c <= 0); 82 | if c = 0 || R.compare inf_d sup_d <= 0 then eps 83 | else V.min eps (V.div_by_coef (V.sub sup_r inf_r) (R.sub inf_d sup_d)) 84 | 85 | let eps_for_mini 86 | (i : Core.var_info) 87 | (min : R2.t) 88 | (eps : V.t) : V.t = 89 | assert (R2.is_pure_rational min || R.equal min.R2.offset R.one); 90 | let eps = eval_eps eps min i.value in 91 | eps 92 | 93 | let eps_for_maxi 94 | (i : Core.var_info) 95 | (max : R2.t) 96 | (eps : V.t) : V.t = 97 | assert (R2.is_pure_rational max || R.equal max.R2.offset R.m_one); 98 | let eps = eval_eps eps i.value max in 99 | eps 100 | 101 | let get_rat_solution = 102 | let compute_epsilon mp eps = 103 | MX.fold (fun _ (i, _) eps -> 104 | let eps' = 105 | match i.mini , i.maxi with 106 | | None, None -> eps 107 | 108 | | Some min, None -> 109 | eps_for_mini i min.bvalue eps 110 | 111 | | None, Some max -> 112 | eps_for_maxi i max.bvalue eps 113 | 114 | | Some min, Some max -> 115 | eps 116 | |> eps_for_mini i min.bvalue 117 | |> eps_for_maxi i max.bvalue 118 | in 119 | assert (V.compare eps' V.zero > 0); 120 | eps' 121 | ) mp eps 122 | in 123 | let compute_solution slake mp eps acc = 124 | MX.fold 125 | (fun x (info, _) (m, s) -> 126 | let {R2.v = q1; offset = q2} = info.value in 127 | let q = V.add q1 (V.mult_by_coef eps q2) in 128 | let q2 = R2.of_r q in 129 | assert (not (violates_min_bound q2 info.mini)); 130 | assert (not (violates_max_bound q2 info.maxi)); 131 | if MX.mem x slake then m, (x, q) :: s else (x,q) :: m, s 132 | )mp acc 133 | in 134 | fun env -> 135 | let eps = compute_epsilon env.basic V.one in 136 | let eps = compute_epsilon env.non_basic eps in 137 | let acc = compute_solution env.slake env.basic eps ([], []) in 138 | let m,s = compute_solution env.slake env.non_basic eps acc in 139 | { main_vars = m ; slake_vars = s; int_sol = false; epsilon = eps } 140 | 141 | 142 | let get_solution env = 143 | if env.is_int then get_int_solution env else get_rat_solution env 144 | 145 | let get_max_info {non_basic; _} p = 146 | let max_v : Core.bound = 147 | Core.P.fold 148 | (fun x c (max_v : Core.bound) -> 149 | let xi, _ = try MX.find x non_basic with Not_found -> assert false in 150 | let bnd = 151 | if R.sign c > 0 152 | then xi.maxi 153 | else xi.mini 154 | in 155 | let ex = match bnd with 156 | | None -> Core.Ex.empty 157 | | Some {explanation; _} -> explanation 158 | in 159 | let value = xi.value in 160 | assert (equals_optimum value bnd); 161 | { 162 | bvalue = R2.add max_v.bvalue (R2.mult_by_const c value); 163 | explanation = Ex.union max_v.explanation ex 164 | } 165 | ) 166 | p 167 | {bvalue = R2.zero; explanation = Ex.empty} 168 | in 169 | {max_v; is_le = R.is_zero max_v.bvalue.R2.offset} 170 | 171 | 172 | let get opt env = 173 | match env.status with 174 | | UNK -> Unknown 175 | | UNSAT s -> Unsat (lazy (get_unsat_core s env)) 176 | | SAT -> 177 | match opt with 178 | | None -> Sat (lazy (get_solution env)) 179 | | Some(_, false) -> Unbounded (lazy (get_solution env)) 180 | | Some(p, true) -> Max (lazy(get_max_info env p), lazy(get_solution env)) 181 | 182 | end 183 | -------------------------------------------------------------------------------- /src/coreSig.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | open ExtSigs 8 | 9 | (** Interface of the main types and auxiliary of the simplex. *) 10 | module type S = sig 11 | 12 | (** {1 Modules} *) 13 | 14 | (** The type of variables maipulated by the simplex algorithm. *) 15 | module Var : Variables 16 | 17 | (** An interface for explanations; in practice, they are labels attached to 18 | bounds used for backtracking information on how bounds were discovered. 19 | The simplex algorithm does not create explanations: it will only attach 20 | empty explanations to bounds, build the union of explanations and print 21 | them. It is the user's job to provide the initial explanations when 22 | initializing the simplex core. *) 23 | module Ex : Explanations 24 | 25 | (** The interface for rationals provided by users for the coefficient. *) 26 | module R : Coefs 27 | 28 | (** The interface for values of variable and bounds provided by users. *) 29 | module V : Value with type r = R.t 30 | 31 | (** Pairs of rationals R representing bounds with an offset [x + kƐ]. *) 32 | module R2 : Rat2.SIG with module R = R and module V = V 33 | 34 | (** Linear relations of variables. *) 35 | module P : Polys.SIG with module Var = Var and module R = R 36 | 37 | (** Collections of variables. *) 38 | module MX : MapSig with type key = Var.t 39 | module SX : SetSig with type elt = Var.t 40 | 41 | (*module SLAKE : Map.S with type key = P.t*) 42 | 43 | (** {1 Types} *) 44 | 45 | (** A bound is a value of the form [x + kƐ] and an explanation. *) 46 | type bound = { 47 | bvalue : R2.t; 48 | explanation : Ex.t 49 | } 50 | 51 | type value_status = 52 | | ValueOK (** The value is inbetween bounds. *) 53 | | LowerKO (** The value is smaller than the lower bound. *) 54 | | UpperKO (** The value is greater than the upper bound. *) 55 | 56 | type var_info = { 57 | mini : bound option; (* None -> -inf *) 58 | maxi : bound option; (* None -> +inf *) 59 | value : R2.t; 60 | vstatus : value_status; 61 | empty_dom : bool; 62 | } 63 | 64 | type solution = { 65 | main_vars : (Var.t * V.t) list; 66 | slake_vars : (Var.t * V.t) list; 67 | int_sol : bool; (* Always set to false for rational simplexes. *) 68 | epsilon : V.t; 69 | } 70 | 71 | type maximum = { 72 | max_v : bound; 73 | is_le : bool; (* bool = true <-> large bound *) 74 | } 75 | 76 | type result = 77 | | Unknown 78 | | Unsat of Ex.t Lazy.t 79 | | Sat of solution Lazy.t 80 | | Unbounded of solution Lazy.t 81 | | Max of maximum Lazy.t * solution Lazy.t 82 | 83 | type simplex_status = UNK | UNSAT of Var.t | SAT 84 | 85 | type t = { 86 | basic : (var_info * P.t) MX.t; 87 | non_basic : (var_info * SX.t) MX.t; 88 | slake : P.t MX.t; 89 | fixme : SX.t; 90 | is_int : bool; 91 | status : simplex_status; 92 | check_invs : bool; 93 | nb_pivots : int ref; 94 | } 95 | 96 | (** Returns a simplex environment with three parameters: 97 | - [is_int]: will the simplex work on an integer optimization problem or a 98 | rational problem? 99 | - [check_invs]: processes checks after the calculation (deprecated). 100 | *) 101 | val empty : is_int : bool -> check_invs : bool -> t 102 | 103 | (** Returns [true] if the simplex environment is on integers. *) 104 | val on_integers : t -> bool 105 | 106 | (** Equality check between bounds. *) 107 | val equals_optimum : R2.t -> bound option -> bool 108 | 109 | (** Checks if the lower bound of a variable is smaller than 110 | its upper bound. *) 111 | val consistent_bounds : var_info -> bool 112 | 113 | (** [violates_min_bound b mb] returns [true] if [b] is smaller than [mb]. *) 114 | val violates_min_bound : R2.t -> bound option -> bool 115 | 116 | (** [violates_max_bound b mb] returns [true] if [b] is greater than [mb]. *) 117 | val violates_max_bound : R2.t -> bound option -> bool 118 | 119 | (* The returned bool is [true] if the asserted bounds are not trivial 120 | (i.e. not implied by known bounds). *) 121 | (** [set_min_bound vinfo b] returns a couple [(vinfo', changed)] where: 122 | - [vinfo'] is the new variable info where the new min bound [b] has 123 | been set. 124 | - [changed] is [true] if the new bound has changed the variable info 125 | *) 126 | val set_min_bound : var_info -> bound option -> var_info * bool 127 | 128 | (** Same as {!val:set_min_bound}, but for max bounds. *) 129 | val set_max_bound : var_info -> bound option -> var_info * bool 130 | 131 | (** [ajust_value_of_non_basic vinfo] updates the info's value with the upper 132 | bound (resp. the lower bound), if [vinfo]'s status is 133 | {!constructor:UpperKO} (resp. {!constructor:LowerKO}). Otherwise, do 134 | nothing. The boolean returned is [true] if the new variable [var_info] 135 | has changed. *) 136 | val ajust_value_of_non_basic: var_info -> var_info * bool 137 | (* vstatus is supposed to be well set *) 138 | 139 | (** [ajust_status_of_basic vinfo] checks a variable info's bound matches 140 | its status. If its value violates its lower bound, its status is set 141 | to {!constructor:LowerKO}. In the other case, it is set to 142 | {!constructor:UpperKO}. If the value is between the two bounds, it is set 143 | to {!constructor:ValueOK}. *) 144 | val ajust_status_of_basic : var_info -> var_info 145 | (* valuation is supposed to be well computed *) 146 | 147 | (** Evaluates a polynomial of non basic variables. *) 148 | val evaluate_poly : t -> P.t -> R2.t 149 | 150 | (** [poly_of_slake env slake] returns the polynomial associated 151 | to the variable [slake] in [env]. *) 152 | val poly_of_slake : t -> Var.t -> P.t option 153 | 154 | (** Returns the explanation associated to a variable lower bound. *) 155 | val expl_of_min_bound : var_info -> Ex.t 156 | 157 | (** Same as `expl_of_min_bound`, but for upper bounds. *) 158 | val expl_of_max_bound : var_info -> Ex.t 159 | 160 | (** {1 Debug functions} *) 161 | (** Only use for internal debugging *) 162 | 163 | (** Checks several invariants in the project *) 164 | val check_invariants : t -> (t -> result) -> unit 165 | 166 | (** Pretty prints the environment. *) 167 | val print : result -> Format.formatter -> t -> unit 168 | 169 | (** @deprecated *) 170 | val debug : string -> t -> (t -> result) -> unit 171 | end 172 | -------------------------------------------------------------------------------- /src/assertBounds.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | module type S = sig 8 | 9 | module Core : CoreSig.S 10 | 11 | val var : 12 | Core.t -> 13 | ?min:Core.bound -> 14 | ?max:Core.bound -> 15 | Core.Var.t -> 16 | Core.t * bool 17 | 18 | val poly : 19 | Core.t -> 20 | Core.P.t -> 21 | ?min:Core.bound -> 22 | ?max:Core.bound -> 23 | Core.Var.t -> 24 | Core.t * bool 25 | 26 | end 27 | 28 | module Make(Core : CoreSig.S) : S with module Core = Core = struct 29 | 30 | module Core = Core 31 | module Result = Result.Make(Core) 32 | open Core 33 | 34 | let empty_info value = { 35 | mini = None; 36 | maxi = None; 37 | value; 38 | vstatus = ValueOK; 39 | empty_dom = false; 40 | } 41 | 42 | (* If the environment works on integers and bounds are strict, 43 | we shift the bound so that it is a large bound. Same goes 44 | on rational bounds in an integer simplex. 45 | Ex: 46 | * x > 5 + Ɛ -> x >= 6 47 | * x > 4/3 -> x >= 2 48 | *) 49 | let update_bound 50 | (get_closer : R2.t -> R2.t) 51 | (env : Core.t) 52 | (bnd : bound option) = 53 | match bnd with 54 | | Some b when env.is_int -> 55 | Some {b with bvalue = get_closer b.bvalue} 56 | | other -> other 57 | 58 | let update_min_bound = update_bound R2.ceiling 59 | let update_max_bound = update_bound R2.floor 60 | 61 | let new_status_basic stt fixme s info consistent_bnds = 62 | let has_bad_value = info.vstatus != ValueOK in 63 | match stt, consistent_bnds with 64 | | UNSAT _, _ -> stt, fixme 65 | | _, false -> 66 | UNSAT s, SX.empty 67 | 68 | | UNK, true -> 69 | stt, if has_bad_value then SX.add s fixme else SX.remove s fixme 70 | 71 | | SAT, _ -> 72 | assert (fixme == SX.empty); 73 | if has_bad_value then UNK, SX.add s fixme else stt, fixme 74 | 75 | let assert_basic_var env x mini maxi = 76 | let info, poly, changed = 77 | try 78 | let info, poly = MX.find x env.basic in 79 | let info, chang1 = set_min_bound info mini in 80 | let info, chang2 = set_max_bound info maxi in 81 | info, poly, chang1 || chang2 82 | with Not_found -> assert false 83 | in 84 | let status, fixme = 85 | new_status_basic env.status env.fixme x info (consistent_bounds info) 86 | in 87 | {env with basic = MX.add x (info, poly) env.basic; status; fixme}, 88 | changed 89 | 90 | (* *) 91 | 92 | let new_status_non_basic x stt fixme ({mini; maxi; value; _} as info) = 93 | match stt with 94 | | UNSAT _ -> stt, fixme 95 | | SAT | UNK when consistent_bounds info -> 96 | assert (not (violates_min_bound value mini)); 97 | assert (not (violates_max_bound value maxi)); 98 | assert (stt != SAT || fixme == SX.empty); 99 | stt, fixme 100 | | SAT | UNK -> 101 | UNSAT x, SX.empty 102 | 103 | let adapt_values_of_basic_vars env _old _new x use = 104 | let {basic; _} = env in 105 | let diff = R2.sub _new _old in 106 | SX.fold 107 | (fun s env -> 108 | let info, p = try MX.find s basic with Not_found -> assert false in 109 | let c_x = try P.find x p with Not_found -> assert false in 110 | let info = 111 | {info with value = R2.add info.value (R2.mult_by_const c_x diff)} 112 | in 113 | let info = ajust_status_of_basic info in 114 | let status, fixme = 115 | new_status_basic env.status env.fixme s info true 116 | in 117 | {env with status; fixme; basic = MX.add s (info, p) env.basic} 118 | )use env 119 | 120 | let assert_non_basic_var env x mini maxi = 121 | let info, use = 122 | try MX.find x env.non_basic 123 | with Not_found -> empty_info R2.zero, SX.empty 124 | in 125 | let info, chang1 = set_min_bound info mini in 126 | let info, chang2 = set_max_bound info maxi in 127 | let old_val = info.value in 128 | let info, changed = ajust_value_of_non_basic info in 129 | let status, fixme = new_status_non_basic x env.status env.fixme info in 130 | let env = 131 | {env with 132 | non_basic = MX.add x (info, use) env.non_basic; status; fixme} 133 | in 134 | let env = 135 | if not changed then env 136 | else adapt_values_of_basic_vars env old_val info.value x use 137 | in 138 | env, chang1 || chang2 139 | 140 | (* exported function: check_invariants called before and after *) 141 | let var env ?min ?max x = 142 | debug "[entry of assert_var]" env (Result.get None); 143 | check_invariants env (Result.get None); 144 | let mini = update_min_bound env min in 145 | let maxi = update_max_bound env max in 146 | let env, changed = 147 | if MX.mem x env.basic then 148 | assert_basic_var env x mini maxi 149 | else 150 | assert_non_basic_var env x mini maxi 151 | in 152 | debug "[exit of assert_var]" env (Result.get None); 153 | check_invariants env (Result.get None); 154 | env, changed 155 | 156 | let register_slake slk p env = 157 | if MX.mem slk env.slake then env, false 158 | else {env with slake = MX.add slk p env.slake}, true 159 | 160 | let update_use is_fresh_slk x_status slk use = 161 | match x_status with 162 | | P.Exists -> 163 | assert (SX.mem slk use); 164 | use 165 | 166 | | P.Removed -> 167 | assert (SX.mem slk use); 168 | SX.remove slk use 169 | 170 | | P.New -> 171 | assert (not is_fresh_slk || not (SX.mem slk use)); 172 | SX.add slk use 173 | 174 | let update_use_list is_fresh modified_stt slk non_basic = 175 | List.fold_left 176 | (fun non_basic (x, x_status) -> 177 | try 178 | let i, u = MX.find x non_basic in 179 | MX.add x (i, update_use is_fresh x_status slk u) non_basic 180 | with Not_found -> assert false 181 | )non_basic modified_stt 182 | 183 | let normalize_polynomial is_fresh slk p env = 184 | P.fold 185 | (fun x c (q, env) -> 186 | try 187 | let info, use = MX.find x env.non_basic in 188 | let new_q, x_status = P.accumulate x c q in 189 | let use = update_use is_fresh x_status slk use in 190 | new_q, {env with non_basic = MX.add x (info, use) env.non_basic} 191 | 192 | with Not_found -> 193 | try 194 | let _ , p_of_x = MX.find x env.basic in 195 | let new_q, modified_stt = P.append q c p_of_x in 196 | new_q, 197 | {env with 198 | non_basic = 199 | update_use_list is_fresh modified_stt slk env.non_basic} 200 | 201 | with Not_found -> 202 | (* var not initied -> new non_basic *) 203 | let env, chang = assert_non_basic_var env x None None in 204 | assert (not chang); 205 | let new_q, x_status = P.replace x c q in 206 | assert (x_status == P.New); 207 | let info, use = 208 | try MX.find x env.non_basic 209 | with Not_found -> assert false 210 | in 211 | let use = update_use is_fresh x_status slk use in 212 | new_q, 213 | { env with 214 | non_basic = MX.add x (info, use) env.non_basic} 215 | )p (P.empty, env) 216 | 217 | 218 | (* exported function: check_invariants called before and after *) 219 | let poly env p ?min ?max slk = 220 | debug "[entry of assert_poly]" env (Result.get None); 221 | check_invariants env (Result.get None); 222 | (* Note: we should not convert the call to [poly] into a call to [var] 223 | here because we introduce the equality [poly = slk] and then we set 224 | the bounds for [slk] to [min] and [max]. 225 | 226 | If there is a single variable (i.e. [poly = k * x] for some 227 | coefficient [k] and variable [x]), we do not want to add the useless 228 | slack variable [slk = k * x]. *) 229 | if not (P.is_polynomial p) then 230 | invalid_arg 231 | "poly: must have two variables or more, use var instead"; 232 | let mini = update_min_bound env min in 233 | let maxi = update_max_bound env max in 234 | let env, is_fresh = register_slake slk p env in 235 | let info, is_basic, env, change = 236 | try (* non basic existing var ? *) 237 | let info, use = MX.find slk env.non_basic in 238 | assert ( 239 | let np, _ = normalize_polynomial is_fresh slk p env in 240 | let zp, _ = P.accumulate slk R.m_one np in 241 | P.is_empty zp 242 | ); 243 | let info, chang1 = set_min_bound info mini in 244 | let info, chang2 = set_max_bound info maxi in 245 | let old_val = info.value in 246 | let info, changed = ajust_value_of_non_basic info in 247 | let env = 248 | {env with non_basic = MX.add slk (info, use) env.non_basic} 249 | in 250 | let env = 251 | if not changed then env 252 | else adapt_values_of_basic_vars env old_val info.value slk use 253 | in 254 | info, false, env, chang1 || chang2 255 | with Not_found -> 256 | try (* basic existing var ? *) 257 | let info, poly = MX.find slk env.basic in 258 | assert ( 259 | let np, _ = normalize_polynomial is_fresh slk p env in 260 | P.equal np poly 261 | ); 262 | let info, chang1 = set_min_bound info mini in 263 | let info, chang2 = set_max_bound info maxi in 264 | info, true, {env with basic = MX.add slk (info, poly) env.basic}, 265 | chang1 || chang2 266 | 267 | with Not_found -> (* fresh basic var *) 268 | assert (is_fresh); 269 | let np, env = normalize_polynomial is_fresh slk p env in 270 | let info = empty_info (evaluate_poly env np) in 271 | let info, chang1 = set_min_bound info mini in 272 | let info, chang2 = set_max_bound info maxi in 273 | info, true, {env with basic = MX.add slk (info, np) env.basic}, 274 | chang1 || chang2 275 | in 276 | let status, fixme = 277 | if is_basic then 278 | new_status_basic env.status env.fixme slk info 279 | (consistent_bounds info) 280 | else 281 | new_status_non_basic slk env.status env.fixme info 282 | in 283 | let env = {env with status; fixme } in 284 | debug "[exit of assert_poly]" env (Result.get None); 285 | check_invariants env (Result.get None); 286 | env, change 287 | 288 | 289 | end 290 | (* end of functor Make *) 291 | -------------------------------------------------------------------------------- /src/solveBounds.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | let src = 8 | Logs.Src.create "OcplibSimplex.SolveBounds" 9 | ~doc:"A module providing arithmetical utilities for solving the simplex" 10 | 11 | module type S = sig 12 | module Core : CoreSig.S 13 | val solve : Core.t -> Core.t 14 | val maximize : Core.t -> Core.P.t -> Core.t * (Core.P.t * bool) option 15 | end 16 | 17 | module Make(Core : CoreSig.S) : S with module Core = Core = struct 18 | 19 | module Core = Core 20 | module Result = Result.Make(Core) 21 | open Core 22 | 23 | 24 | let gauss_pivot s p x c = 25 | let p, _ = P.replace s R.m_one (P.remove x p) in 26 | let c = R.div R.m_one c in 27 | if R.is_one c then p 28 | else P.fold (fun y d q -> fst (P.replace y (R.mult c d) q)) p P.empty 29 | 30 | exception Out of Var.t * R.t * var_info * SX.t 31 | 32 | let look_for_next_pivot si pi non_basic = 33 | let status = si.vstatus in 34 | let is_lower = 35 | match status with 36 | | ValueOK -> assert false | LowerKO -> 1 | UpperKO -> -1 37 | in 38 | try 39 | P.iter 40 | (fun x coef -> 41 | let xi,use = try MX.find x non_basic with Not_found -> assert false in 42 | let c = is_lower * R.sign coef in 43 | assert (c <> 0); 44 | if c > 0 && not (equals_optimum xi.value xi.maxi) then 45 | raise (Out (x, coef, xi, use)); 46 | if c < 0 && not (equals_optimum xi.value xi.mini) then 47 | raise (Out (x, coef, xi, use)); 48 | )pi; 49 | None 50 | with Out (x, c, xi, use) -> Some (x, c, xi, use) 51 | 52 | 53 | let adapt_valuation_of_newly_basic old_si new_si old_xi c_x = 54 | let diff = R2.div_by_const c_x (R2.sub new_si.value old_si.value) in 55 | { old_xi with value = R2.add diff old_xi.value } 56 | 57 | 58 | (* 59 | let string_of_var_status stt = 60 | match stt with 61 | | P.Removed -> "Removed" 62 | | P.New -> "New" 63 | | P.Exists -> "Exists" 64 | *) 65 | 66 | (* TODO : review and improve this function *) 67 | 68 | let rec solve_rec env round = 69 | Core.debug (Format.sprintf "[solve] round %d" round) env (Result.get None); 70 | Core.check_invariants env (Result.get None); 71 | if SX.is_empty env.fixme then {env with status = SAT} 72 | else 73 | let s = SX.choose env.fixme in 74 | let fixme = SX.remove s env.fixme in 75 | let si, p = try MX.find s env.basic with Not_found -> assert false in 76 | match look_for_next_pivot si p env.non_basic with 77 | | None -> {env with fixme = SX.empty; status = UNSAT s} 78 | 79 | | Some(x, c, xi, use_x) -> 80 | Logs.debug ~src (fun p -> 81 | p ~header:"[solve_rec]" 82 | "pivot basic %a and non-basic %a@." 83 | Var.print s Var.print x 84 | ); 85 | let basic = MX.remove s env.basic in 86 | let non_basic = MX.remove x env.non_basic in 87 | let q = gauss_pivot s p x c in 88 | assert (SX.mem s use_x); 89 | let use_x = SX.remove s use_x in 90 | let old_si = si in 91 | let si, changed = Core.ajust_value_of_non_basic si in 92 | assert (changed); 93 | 94 | let old_xi = xi in 95 | let xi = adapt_valuation_of_newly_basic old_si si xi c in 96 | let xi = ajust_status_of_basic xi in 97 | let diff_xi_val = R2.sub xi.value old_xi.value in 98 | let fixme = (* do this earlier to detect bad pivots *) 99 | if xi.vstatus == ValueOK then fixme 100 | else SX.add x fixme 101 | in 102 | let non_basic = 103 | P.fold 104 | (fun y _ non_basic -> 105 | let yi, use_y = 106 | try MX.find y non_basic with Not_found -> assert false in 107 | MX.add y (yi, SX.add x (SX.remove s use_y)) non_basic 108 | )(P.remove s q) non_basic 109 | in 110 | 111 | let non_basic = MX.add s (si, SX.add x use_x) non_basic in 112 | 113 | let basic, non_basic, fixme = 114 | SX.fold 115 | (fun t (basic, non_basic, fixme) -> 116 | let ti0, r = try MX.find t basic with Not_found -> assert false in 117 | let cx = try P.find x r with Not_found -> assert false in 118 | (*should update_ti*) 119 | let diff_cx = R2.mult_by_const cx diff_xi_val in 120 | let ti = {ti0 with value = R2.add ti0.value diff_cx} in 121 | let ti = ajust_status_of_basic ti in 122 | let r', changed = P.subst x q r in 123 | (* 124 | Format.eprintf "update poly of basic %a@." Var.print t; 125 | List.iter 126 | (fun (v, vstt) -> 127 | Format.eprintf " %a ---> %s@." 128 | Var.print v (string_of_var_status vstt); 129 | )changed; 130 | *) 131 | let non_basic = 132 | List.fold_left 133 | (fun non_basic (z, vstt) -> 134 | match vstt with 135 | | P.Exists -> non_basic 136 | | P.New -> 137 | let zi, use_z = 138 | try MX.find z non_basic with Not_found -> assert false 139 | in 140 | MX.add z (zi, SX.add t use_z) non_basic 141 | 142 | | P.Removed -> 143 | if Var.compare z x = 0 then non_basic 144 | else 145 | let zi, use_z = 146 | try MX.find z non_basic with Not_found -> assert false 147 | in 148 | MX.add z (zi, SX.remove t use_z) non_basic 149 | )non_basic changed 150 | in 151 | (*val subst : Var.t -> t -> t -> t * (Var.t * var_status) list*) 152 | 153 | let basic = MX.add t (ti, r') basic in 154 | let fixme = 155 | if ti.vstatus == ValueOK then 156 | if ti0.vstatus == ValueOK then fixme 157 | else SX.remove t fixme 158 | else SX.add t fixme 159 | in 160 | basic, non_basic, fixme 161 | )use_x (basic, non_basic, fixme) 162 | in 163 | 164 | (* ... *) 165 | 166 | let basic = MX.add x (xi, q) basic in 167 | 168 | (* ... *) 169 | 170 | let env = {env with fixme; basic; non_basic} in 171 | env.nb_pivots := !(env.nb_pivots) + 1; 172 | solve_rec env (round + 1) 173 | 174 | 175 | let solve env = 176 | Core.debug "[entry of solve]" env (Result.get None); 177 | Core.check_invariants env (Result.get None); 178 | let env = 179 | match env.Core.status with 180 | | Core.UNSAT _ | Core.SAT -> env 181 | | Core.UNK -> solve_rec env 1 182 | in 183 | Core.debug "[exit of solve]" env (Result.get None); 184 | Core.check_invariants env (Result.get None); 185 | env 186 | 187 | 188 | 189 | 190 | 191 | 192 | let non_basic_to_maximize {non_basic=n_b; _} opt = 193 | let acc = ref None in 194 | try 195 | P.iter 196 | (fun x c -> 197 | let xi, use = try MX.find x n_b with Not_found -> assert false in 198 | let sg = R.sign c in 199 | if sg > 0 && not (equals_optimum xi.value xi.maxi) || 200 | sg < 0 && not (equals_optimum xi.value xi.mini) then begin 201 | acc := Some (x, c, xi, use, sg > 0); 202 | raise Exit 203 | end 204 | )opt; 205 | !acc 206 | with Exit -> !acc 207 | 208 | 209 | type 'a maximiza_basic = 210 | | Free 211 | | Stuck 212 | | Progress of 'a 213 | 214 | 215 | let basic_var_to_pivot_for_maximization = 216 | let choose_best_pivot acc s si p c_px bnd_opt is_min = 217 | match bnd_opt with 218 | | None -> 219 | if !acc = Stuck then acc := Free (* !!! to check *) 220 | 221 | | Some {bvalue = bnd; _} -> 222 | let tmp = if is_min then R2.sub si.value bnd else R2.sub bnd si.value in 223 | let ratio = R2.div_by_const (R.abs c_px) tmp in 224 | begin 225 | match !acc with 226 | | Free | Stuck -> 227 | acc := Progress (ratio, s, si, p, c_px, bnd, is_min) 228 | 229 | | Progress (r_old,_,_,_,_,_,_) -> 230 | if R2.compare r_old ratio > 0 then 231 | acc := Progress (ratio, s, si, p, c_px, bnd, is_min) 232 | end; 233 | if R2.is_zero ratio then raise Exit (* in the case, the pivot is found*) 234 | in 235 | fun {basic; _} x use_x should_incr_x -> 236 | (* Initially, we assume that we are stuck, unless, use_x is empty *) 237 | let acc = ref (if SX.is_empty use_x then Free else Stuck) in 238 | try 239 | SX.iter 240 | (fun s -> 241 | let si, p = try MX.find s basic with Not_found -> assert false in 242 | let c_px = try P.find x p with Not_found -> assert false in 243 | let sg = R.sign c_px in 244 | assert (sg <> 0); 245 | match should_incr_x, sg > 0, si.mini, si.maxi with 246 | | true , true , _, mx_opt -> 247 | (* by increasing x, s will increase and max(s) <> +infty *) 248 | choose_best_pivot acc s si p c_px mx_opt false 249 | 250 | | true , false, mn_opt, _ -> 251 | (* by increasing x, s will decrease and min(s) <> -infty *) 252 | choose_best_pivot acc s si p c_px mn_opt true 253 | 254 | | false, true , mn_opt, _ -> 255 | (* by decreasing x, s will decreease and min(s) <> -infty *) 256 | choose_best_pivot acc s si p c_px mn_opt true 257 | 258 | | false, false, _, mx_opt -> 259 | (* by decreasning x, s will increase and max(s) <> +infty *) 260 | choose_best_pivot acc s si p c_px mx_opt false 261 | 262 | (*| true, true, _, None 263 | | true, false, None, _ 264 | | false, true, None, _ 265 | | false, false, _, None -> 266 | (* for the cases where max or max = infty, we keep acc unchanged. 267 | if acc = None at the end, the problem is unbounded *) 268 | () 269 | *) 270 | )use_x; 271 | !acc 272 | with Exit -> !acc 273 | 274 | 275 | let can_fix_valuation_without_pivot should_incr xi ratio_opt = 276 | if should_incr then 277 | match xi.maxi, ratio_opt with 278 | | None, _ -> None 279 | | Some {bvalue = bnd; _}, Some ratio -> 280 | let diff = R2.sub bnd xi.value in 281 | if R2.compare diff ratio < 0 then Some ({xi with value = bnd}, diff) 282 | else None 283 | 284 | | Some {bvalue = bnd; _}, None -> 285 | let diff = R2.sub bnd xi.value in 286 | Some ({xi with value = bnd}, diff) 287 | 288 | else 289 | match xi.mini, ratio_opt with 290 | | None, _ -> None 291 | | Some {bvalue = bnd; _}, Some ratio -> 292 | let diff = R2.sub xi.value bnd in 293 | if R2.compare diff ratio < 0 then Some ({xi with value = bnd}, diff) 294 | else None 295 | 296 | | Some {bvalue = bnd; _}, None -> 297 | let diff = R2.sub xi.value bnd in 298 | Some ({xi with value = bnd}, diff) 299 | 300 | 301 | let update_valuation_without_pivot 302 | ({basic; non_basic; _ } as env) x use_x new_xi diff _should_incr = 303 | let non_basic = MX.add x (new_xi, use_x) non_basic in 304 | let diff = if _should_incr then diff else R2.minus diff in 305 | let basic = 306 | SX.fold 307 | (fun s basic -> 308 | let si, p = try MX.find s basic with Not_found -> assert false in 309 | let cx = try P.find x p with Not_found -> assert false in 310 | assert (not (R.is_zero cx)); 311 | let delta = R2.mult_by_const cx diff in 312 | let si = {si with value = R2.add si.value delta} in 313 | MX.add s (si, p) basic 314 | )use_x basic 315 | in 316 | {env with basic; non_basic} 317 | 318 | let rec maximize_rec env opt rnd = 319 | Logs.debug ~src (fun p -> p "[maximize_rec] round %d // OPT = %a@." rnd P.print opt); 320 | Core.debug 321 | (Format.sprintf "[maximize_rec] round %d" rnd) env (Result.get None); 322 | Core.check_invariants env (Result.get None); 323 | match non_basic_to_maximize env opt with 324 | | None -> Logs.debug (fun p -> p "max reached@."); 325 | rnd, env, Some (opt, true) (* max reached *) 326 | 327 | | Some (_x, _c, _xi, _use_x, _should_incr) -> 328 | Logs.debug (fun p -> p "pivot non basic var %a ?@." Var.print _x); 329 | match basic_var_to_pivot_for_maximization env _x _use_x _should_incr with 330 | | Free -> 331 | Logs.debug (fun p -> p "non basic %a not constrained by basic vars: Set it to max@." 332 | Var.print _x); 333 | begin 334 | match can_fix_valuation_without_pivot _should_incr _xi None with 335 | | Some (new_xi, diff) -> 336 | Logs.debug (fun p -> p 337 | "No --> I can set value of %a to min/max WO pivot@." 338 | Var.print _x); 339 | let env, opt = 340 | update_valuation_without_pivot 341 | env _x _use_x new_xi diff _should_incr, opt 342 | in 343 | (* no pivot *) 344 | maximize_rec env opt (rnd + 1) 345 | | None -> 346 | Logs.debug (fun p -> p 347 | "no pivot finally(no upper bnd), pb unbounded@."); 348 | rnd, env, Some (opt, false) (* unbounded *) 349 | end 350 | | Stuck -> 351 | Logs.debug (fun p -> p "no pivot finally, pb unbounded@."); 352 | rnd, env, Some (opt, false) (* unbounded *) 353 | 354 | | Progress (ratio, s, si, p, c_px, bnd, _is_min) -> 355 | Logs.debug (fun p -> p "pivot with basic var %a ?@." Var.print s); 356 | let env, opt = 357 | match 358 | can_fix_valuation_without_pivot _should_incr _xi (Some ratio) with 359 | | Some (new_xi, diff) -> 360 | Logs.debug (fun p -> p 361 | "No --> I can set value of %a to min/max WO pivot@." 362 | Var.print _x); 363 | update_valuation_without_pivot 364 | env _x _use_x new_xi diff _should_incr, opt 365 | 366 | | None -> 367 | let x = _x in 368 | let c = c_px in 369 | let use_x = _use_x in 370 | let xi = _xi in 371 | Logs.debug (fun p -> p 372 | "[maximize_rec] pivot basic %a and non-basic %a@." 373 | Var.print s Var.print x); 374 | let basic = MX.remove s env.basic in 375 | let non_basic = MX.remove x env.non_basic in 376 | let q = gauss_pivot s p x c in 377 | assert (SX.mem s use_x); 378 | let use_x = SX.remove s use_x in 379 | let old_si = si in 380 | 381 | let si = {si with value = bnd} in (* difference wrt solve *) 382 | (* 383 | because the code of solve below, assumes that value in si 384 | violotas a bound 385 | let si, changed = Core.ajust_value_of_non_basic si in 386 | assert (changed); 387 | *) 388 | 389 | let old_xi = xi in 390 | let xi = adapt_valuation_of_newly_basic old_si si xi c in 391 | let xi = ajust_status_of_basic xi in 392 | let diff_xi_val = R2.sub xi.value old_xi.value in 393 | assert(xi.vstatus == ValueOK); 394 | let non_basic = 395 | P.fold 396 | (fun y _ non_basic -> 397 | let yi, use_y = 398 | try MX.find y non_basic with Not_found -> assert false in 399 | MX.add y (yi, SX.add x (SX.remove s use_y)) non_basic 400 | )(P.remove s q) non_basic 401 | in 402 | 403 | let non_basic = MX.add s (si, SX.add x use_x) non_basic in 404 | 405 | let basic, non_basic = 406 | SX.fold 407 | (fun t (basic, non_basic) -> 408 | let ti0, r = 409 | try MX.find t basic with Not_found -> assert false in 410 | let cx = try P.find x r with Not_found -> assert false in 411 | (*should update_ti*) 412 | let diff_cx = R2.mult_by_const cx diff_xi_val in 413 | let ti = {ti0 with value = R2.add ti0.value diff_cx} in 414 | let ti = ajust_status_of_basic ti in 415 | let r', changed = P.subst x q r in 416 | 417 | let non_basic = 418 | List.fold_left 419 | (fun non_basic (z, vstt) -> 420 | match vstt with 421 | | P.Exists -> non_basic 422 | | P.New -> 423 | let zi, use_z = 424 | try MX.find z non_basic 425 | with Not_found -> assert false 426 | in 427 | MX.add z (zi, SX.add t use_z) non_basic 428 | 429 | | P.Removed -> 430 | if Var.compare z x = 0 then non_basic 431 | else 432 | let zi, use_z = 433 | try MX.find z non_basic 434 | with Not_found -> assert false 435 | in 436 | MX.add z (zi, SX.remove t use_z) non_basic 437 | )non_basic changed 438 | in 439 | 440 | let basic = MX.add t (ti, r') basic in 441 | assert(ti.vstatus == ValueOK); 442 | basic, non_basic 443 | )use_x (basic, non_basic) 444 | in 445 | 446 | (* ... *) 447 | let basic = MX.add x (xi, q) basic in 448 | 449 | (* ... *) 450 | {env with basic; non_basic}, (fst (P.subst x q opt)) 451 | 452 | 453 | 454 | in 455 | env.nb_pivots := !(env.nb_pivots) + 1; 456 | maximize_rec env opt (rnd + 1) 457 | 458 | 459 | let maximize env opt0 = 460 | let env = solve env in 461 | match env.status with 462 | | UNK -> assert false 463 | | UNSAT _ -> env, None 464 | | SAT -> 465 | Logs.debug (fun p -> p "[maximize] pb SAT! try to maximize %a@." P.print opt0); 466 | let {basic; non_basic; _} = env in 467 | let unbnd = ref false in 468 | let opt = 469 | P.fold 470 | (fun x c acc -> 471 | if MX.mem x non_basic then fst (P.accumulate x c acc) 472 | else 473 | try fst (P.append acc c (snd (MX.find x basic))) 474 | with Not_found -> 475 | unbnd := true; 476 | fst (P.accumulate x c acc) 477 | )opt0 P.empty 478 | in 479 | if !unbnd then env, Some (opt, false) (* unbounded *) 480 | else 481 | begin 482 | Logs.debug (fun p -> p "start maximization@."); 483 | let rnd, env, is_max = maximize_rec env opt 1 in 484 | Core.check_invariants env (Result.get is_max); 485 | Logs.debug (fun p -> p "[maximize] pb SAT! Max found ? %b for %a == %a@." 486 | (is_max != None) P.print opt0 P.print opt); 487 | Logs.debug (fun p -> p "maximization done after %d steps@." rnd); 488 | env, is_max 489 | end 490 | 491 | 492 | 493 | 494 | end 495 | -------------------------------------------------------------------------------- /src/core.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocplib-simplex *) 3 | (* *) 4 | (* Copyright (C) --- OCamlPro --- See README.md for information and licensing *) 5 | (******************************************************************************) 6 | 7 | open Format 8 | open ExtSigs 9 | 10 | let src = Logs.Src.create "OcplibSimplex.Core" ~doc:"The Core of the simplex solver" 11 | 12 | module MakeExpert 13 | (Var : Variables) 14 | (R : Coefs) 15 | (V : Value with type r = R.t) 16 | (Ex : Explanations) 17 | (R2 : Rat2.SIG with module R = R and module V = V) 18 | (P : Polys.SIG with module Var = Var and module R = R) 19 | (MX : MapSig with type key = Var.t) 20 | (SX : SetSig with type elt = Var.t) 21 | : CoreSig.S with module Var=Var and module R=R and module V = V 22 | and module Ex=Ex and 23 | module P = P and module MX = MX and module SX = SX = struct 24 | 25 | module Var = Var 26 | module R = R 27 | module V = V 28 | module Ex = Ex 29 | 30 | module R2 = R2 31 | 32 | module P = P 33 | 34 | module MX = MX 35 | module SX = SX 36 | 37 | type bound = { 38 | bvalue : R2.t; 39 | explanation : Ex.t 40 | } 41 | 42 | type value_status = ValueOK | LowerKO | UpperKO 43 | 44 | type var_info = 45 | { 46 | mini : bound option; 47 | maxi : bound option; 48 | value : R2.t; 49 | vstatus : value_status; 50 | empty_dom : bool; 51 | } 52 | 53 | type solution = { 54 | main_vars : (Var.t * V.t) list; 55 | slake_vars : (Var.t * V.t) list; 56 | int_sol : bool; (* always set to false for rational simplexes*) 57 | epsilon : V.t; 58 | } 59 | 60 | type maximum = 61 | { max_v : bound; 62 | is_le : bool; (* bool = true <-> large bound *) 63 | } 64 | 65 | type result = 66 | | Unknown 67 | | Unsat of Ex.t Lazy.t 68 | | Sat of solution Lazy.t 69 | | Unbounded of solution Lazy.t 70 | | Max of maximum Lazy.t * solution Lazy.t 71 | 72 | type simplex_status = UNK | UNSAT of Var.t | SAT 73 | 74 | type t = 75 | { 76 | basic : (var_info * P.t) MX.t; 77 | non_basic : (var_info * SX.t) MX.t; 78 | slake : P.t MX.t; 79 | fixme : SX.t; 80 | is_int : bool; 81 | status : simplex_status; 82 | check_invs: bool; 83 | nb_pivots : int ref; 84 | } 85 | 86 | let empty ~is_int ~check_invs = 87 | { 88 | basic = MX.empty; 89 | non_basic = MX.empty; 90 | slake = MX.empty; 91 | fixme = SX.empty; 92 | status = UNK; 93 | is_int; 94 | check_invs; 95 | nb_pivots = ref 0 96 | } 97 | 98 | let on_integers env = env.is_int 99 | 100 | let equals_optimum (b : R2.t) (opt : bound option) = match opt with 101 | | None -> false 102 | | Some opt -> R2.compare b opt.bvalue = 0 103 | 104 | let violates_min_bound (b : R2.t) (mn : bound option) = 105 | match mn with 106 | | None -> false (* min is -infinity *) 107 | | Some min -> R2.compare b min.bvalue < 0 108 | 109 | let violates_max_bound (b : R2.t) (mx : bound option) = 110 | match mx with 111 | | None -> false (* max is +infinity *) 112 | | Some max -> R2.compare b max.bvalue > 0 113 | 114 | let consistent_bound_value min max = R2.compare min max <= 0 115 | 116 | let consistent_bounds_aux (mini : bound option) (maxi : bound option) = 117 | match mini, maxi with 118 | | None, None | Some _, None | None, Some _ -> true 119 | | Some {bvalue = min; _}, Some {bvalue = max; _} -> consistent_bound_value min max 120 | 121 | let consistent_bounds info = 122 | consistent_bounds_aux info.mini info.maxi 123 | 124 | let set_min_bound info (bnd : bound option) = 125 | match bnd with 126 | | None -> info, false 127 | | Some _new -> 128 | let mini = info.mini in 129 | if violates_min_bound _new.bvalue mini || equals_optimum _new.bvalue mini then 130 | info, false 131 | else 132 | let empty_dom = not (consistent_bounds_aux bnd info.maxi) in 133 | let i' = 134 | if violates_min_bound info.value bnd then 135 | {info with mini = bnd; vstatus = LowerKO; empty_dom} 136 | else 137 | {info with mini = bnd; empty_dom} 138 | in i', true 139 | 140 | let set_max_bound info (bnd : bound option) = 141 | match bnd with 142 | | None -> info, false 143 | | Some _new -> 144 | let maxi = info.maxi in 145 | if violates_max_bound _new.bvalue maxi || equals_optimum _new.bvalue maxi then 146 | info, false 147 | else 148 | let empty_dom = not (consistent_bounds_aux info.mini bnd) in 149 | let i' = 150 | if violates_max_bound info.value bnd then 151 | {info with maxi = bnd; vstatus = UpperKO; empty_dom} 152 | else 153 | {info with maxi = bnd; empty_dom} 154 | in 155 | i', true 156 | 157 | let ajust_value_of_non_basic info = 158 | if info.empty_dom then begin 159 | assert (info.vstatus != ValueOK); 160 | info, false (* not changed if not sat_bnds *) 161 | end 162 | else 163 | match info.vstatus with 164 | | ValueOK -> 165 | info, false 166 | | UpperKO -> 167 | {info with 168 | vstatus = ValueOK; 169 | value = match info.maxi with 170 | | None -> assert false 171 | | Some bnd -> bnd.bvalue}, 172 | true 173 | 174 | | LowerKO -> 175 | {info with 176 | vstatus = ValueOK; 177 | value = match info.mini with 178 | | None -> assert false 179 | | Some bnd -> bnd.bvalue}, 180 | true 181 | 182 | 183 | let ajust_status_of_basic info = 184 | let _new = 185 | if violates_min_bound info.value info.mini then LowerKO 186 | else if violates_max_bound info.value info.maxi then UpperKO 187 | else ValueOK 188 | in 189 | if info.vstatus == _new then info else {info with vstatus = _new} 190 | 191 | 192 | let evaluate_poly {non_basic; _} p = 193 | P.fold 194 | (fun x c acc -> 195 | let {value = v; _}, _ = 196 | try MX.find x non_basic with Not_found -> assert false 197 | in 198 | R2.add acc (R2.mult_by_const c v) 199 | )p R2.zero 200 | 201 | 202 | let poly_of_slake env slk = 203 | try Some (MX.find slk env.slake) with Not_found -> None 204 | 205 | let expl_of_min_bound vinfo = 206 | match vinfo.mini with 207 | | None -> Ex.empty 208 | | Some {explanation; _} -> explanation 209 | 210 | let expl_of_max_bound vinfo = 211 | match vinfo.maxi with 212 | | None -> Ex.empty 213 | | Some {explanation; _} -> explanation 214 | 215 | (* debug functions *) 216 | 217 | module Debug = struct 218 | 219 | let string_of_status = function 220 | | ValueOK -> "OK " 221 | | UpperKO -> "KO(Upper)" 222 | | LowerKO -> "KO(Lower)" 223 | 224 | let print_min_bound fmt (i : var_info) = 225 | match i.mini with 226 | | None -> fprintf fmt "-∞ <" 227 | | Some min -> fprintf fmt "%a <=" R2.print min.bvalue 228 | let print_max_bound fmt i = 229 | match i.maxi with 230 | | None -> fprintf fmt "< +∞" 231 | | Some max -> 232 | fprintf fmt "<= %a" R2.print max.bvalue 233 | 234 | let re_computed_status_of_info v = 235 | if violates_min_bound v.value v.mini then LowerKO 236 | else if violates_max_bound v.value v.maxi then UpperKO 237 | else ValueOK 238 | 239 | let print_bounds_and_values fmt mx = 240 | MX.iter 241 | (fun x (info, _) -> 242 | let v = info.value in 243 | let comp_status = re_computed_status_of_info info in 244 | Format.fprintf fmt 245 | "%a [ %a == %a ] %a (computed %s) (flag %s)@." 246 | print_min_bound info 247 | Var.print x 248 | R2.print v 249 | print_max_bound info 250 | (string_of_status comp_status) 251 | (string_of_status info.vstatus); 252 | assert (info.empty_dom || comp_status == info.vstatus); 253 | )mx 254 | 255 | let print_uses fmt non_basic = 256 | MX.iter 257 | (fun x (_, use_x) -> 258 | Format.fprintf fmt 259 | "variables that use %a are:%a@." 260 | Var.print x 261 | (fun fmt s -> SX.iter(fprintf fmt " %a," Var.print) s) use_x; 262 | )non_basic 263 | 264 | let print_solution = 265 | let aux fmt l = 266 | List.iter 267 | (fun (x, q) -> 268 | fprintf fmt " %a --> %a@." Var.print x V.print q; 269 | )l 270 | in 271 | fun is_int fmt s -> 272 | if is_int 273 | then fprintf fmt " (int solution ? %b)@." 274 | s.int_sol; 275 | aux fmt s.main_vars; 276 | aux fmt s.slake_vars 277 | 278 | let print_result is_int fmt status = 279 | match status with 280 | | Unknown -> fprintf fmt "Unknown" 281 | | Sat s -> 282 | fprintf fmt "Sat:@.%a@." (print_solution is_int) (Lazy.force s) 283 | 284 | | Unsat ex -> 285 | fprintf fmt "Unsat:%a@." Ex.print (Lazy.force ex) 286 | 287 | | Unbounded s -> 288 | fprintf fmt "Unbounded:@.%a@." (print_solution is_int) (Lazy.force s) 289 | 290 | | Max(mx, s) -> 291 | let mx = Lazy.force mx in 292 | fprintf fmt "Max: (v=%a, is_le=%b, ex=%a)@.%a@." 293 | R2.print mx.max_v.bvalue mx.is_le Ex.print mx.max_v.explanation 294 | (print_solution is_int) (Lazy.force s) 295 | 296 | let print_fixme fmt sx = 297 | match SX.elements sx with 298 | | [] -> fprintf fmt " (fixme is empty)@."; 299 | | l -> List.iter (fprintf fmt " >> %a@." Var.print) l 300 | 301 | let print_matrix fmt env = 302 | MX.iter 303 | (fun x (_, p) -> 304 | fprintf fmt "%a = %a@." 305 | Var.print x 306 | P.print p) 307 | env.basic 308 | 309 | let print result fmt env = 310 | Format.fprintf fmt 311 | "== begin ========================================@."; 312 | fprintf fmt "on integers ? %b@." env.is_int; 313 | fprintf fmt "--- values of non-basic ---------------------------@."; 314 | print_bounds_and_values fmt env.non_basic; 315 | fprintf fmt "---------------------------------------------------@."; 316 | fprintf fmt "--- values of basic -------------------------------@."; 317 | fprintf fmt "---------------------------------------------------@."; 318 | print_bounds_and_values fmt env.basic; 319 | fprintf fmt "--- matrix ----------------------------------------@."; 320 | print_matrix fmt env; 321 | fprintf fmt "---------------------------------------------------@."; 322 | fprintf fmt "--- sets of uses ----------------------------------@."; 323 | print_uses fmt env.non_basic; 324 | fprintf fmt "---------------------------------------------------@."; 325 | fprintf fmt "--- basic variables in fixme ----------------------@."; 326 | print_fixme fmt env.fixme; 327 | fprintf fmt "---------------------------------------------------@."; 328 | fprintf fmt "--- simplex status --------------------------------@."; 329 | fprintf fmt "%a@." (print_result env.is_int) result; 330 | fprintf fmt 331 | "== end ==========================================@."; 332 | end 333 | (* end of module Debug *) 334 | 335 | let print = Debug.print 336 | 337 | let debug msg env get_result = 338 | if Logs.Src.level src <> None then 339 | let result = get_result env in 340 | Logs.info ~src (fun p -> p "@.%s@.%a@." msg (print result) env) 341 | 342 | (* 343 | check invariants of the simplex: 344 | these invariants are listed in extra/simplexe_invariants.txt 345 | *) 346 | 347 | module SP : Set.S with type elt = P.t = Set.Make(P) 348 | 349 | let get_all_polys env = 350 | let sp = MX.fold (fun _ (_,p) sp -> SP.add p sp) env.basic SP.empty in 351 | MX.fold (fun _ p sp -> SP.add p sp) env.slake sp 352 | 353 | let get_all_vars env all_polys = 354 | let sx = env.fixme in 355 | let sx = MX.fold (fun x _ sx -> SX.add x sx) env.basic sx in 356 | let sx = 357 | MX.fold (fun x (_, use) sx -> 358 | SX.union use (SX.add x sx)) env.non_basic sx 359 | in 360 | let sx = MX.fold (fun x _ sx -> SX.add x sx) env.slake sx in 361 | SP.fold (P.fold (fun x _ sx -> SX.add x sx)) all_polys sx 362 | 363 | let info_of x env = 364 | try fst (MX.find x env.non_basic) 365 | with Not_found -> 366 | try fst (MX.find x env.basic) with Not_found -> assert false 367 | 368 | let _01__check_type is_int all_vars = 369 | SX.iter (fun x -> assert (is_int == Var.is_int x)) all_vars 370 | 371 | let _02__check_basic_non_basic_disjoint env = 372 | MX.iter (fun x _ -> assert (not (MX.mem x env.non_basic))) env.basic; 373 | MX.iter (fun x _ -> assert (not (MX.mem x env.basic))) env.non_basic 374 | 375 | let _03__check_vars_of_polys env polys = 376 | SP.iter 377 | (P.iter 378 | (fun x c -> 379 | assert (R.sign c <> 0); 380 | assert (MX.mem x env.basic || MX.mem x env.non_basic) 381 | ))polys 382 | 383 | let _04_05_06__check_use env = 384 | MX.iter 385 | (fun x (_, use) -> 386 | SX.iter (fun s -> 387 | assert (not (MX.mem s env.non_basic)); (* 04 *) 388 | try assert (P.mem x (snd (MX.find s env.basic))) (*05*) 389 | with Not_found -> assert false 390 | ) use 391 | )env.non_basic; 392 | MX.iter 393 | (fun s (_, p) -> 394 | P.iter (fun x _ -> 395 | try assert (SX.mem s (snd (MX.find x env.non_basic))); (*06*) 396 | with Not_found -> assert false 397 | )p; 398 | )env.basic 399 | 400 | let _07__values_ok_for_non_basic_vars env = 401 | MX.iter 402 | (fun _ (info, _) -> 403 | if consistent_bounds info then begin 404 | assert (not (violates_min_bound info.value info.mini)); 405 | assert (not (violates_max_bound info.value info.maxi)); 406 | end 407 | else 408 | match env.status with 409 | | UNSAT _ -> () 410 | | SAT | UNK -> assert false 411 | )env.non_basic 412 | 413 | let _08_09__values_ok_when_sat env result = 414 | let check mx int_sol = 415 | MX.iter 416 | (fun _ (info, _) -> 417 | let v = info.value in 418 | assert (not (violates_min_bound v info.mini)); 419 | assert (not (violates_max_bound v info.maxi)); 420 | assert (not int_sol || V.is_int v.R2.v && R.is_zero v.R2.offset) 421 | ) mx 422 | in 423 | match result with 424 | | Unsat _ | Unknown -> () 425 | | Sat s | Unbounded s | Max(_,s) -> 426 | let s = Lazy.force s in 427 | check env.basic s.int_sol; check env.non_basic s.int_sol 428 | 429 | 430 | let _10_11__check_handling_strict_ineqs env = 431 | let is_int = env.is_int in 432 | let aux _ (info, _) = 433 | begin 434 | match info.mini with 435 | | None -> () 436 | | Some m -> 437 | let i = m.bvalue.R2.offset in 438 | assert (not is_int || R.is_zero i); 439 | assert (is_int || R.is_zero i || R.is_one i); 440 | end; 441 | begin 442 | match info.maxi with 443 | | None -> () 444 | | Some m -> 445 | let i = m.bvalue.R2.offset in 446 | assert (not is_int || R.is_zero i); 447 | assert (is_int || R.is_zero i || R.is_m_one i); 448 | end 449 | in 450 | MX.iter aux env.basic; 451 | MX.iter aux env.non_basic 452 | 453 | let _12__check_solution_when_sat = 454 | let aux l env = 455 | List.iter 456 | (fun (x, v) -> 457 | let info = info_of x env in 458 | let v2 = R2.of_r v in 459 | assert (not (violates_min_bound v2 info.mini)); 460 | assert (not (violates_max_bound v2 info.maxi)); 461 | )l 462 | in fun env result -> 463 | match result with 464 | | Unsat _ | Unknown -> () 465 | | Sat s | Unbounded s | Max(_,s) -> 466 | let s = Lazy.force s in 467 | let v = List.length s.main_vars + List.length s.slake_vars in 468 | let w = MX.cardinal env.non_basic + MX.cardinal env.basic in 469 | assert ( 470 | if v <> w then 471 | eprintf "model length = %d, but basic + non_basic = %d@." v w; 472 | v = w); 473 | aux s.main_vars env; 474 | aux s.slake_vars env 475 | 476 | let _13__check_reason_when_unsat _env = 477 | Logs.info ~src (fun p -> 478 | p ~header:"[check-invariants]" "@._13__check_reason_when_unsat: TODO@.@." 479 | ) 480 | 481 | let _14_15__fixme_is_subset_of_basic env = 482 | SX.iter 483 | (fun x -> 484 | try 485 | let info, _ = MX.find x env.basic in 486 | assert 487 | ((violates_min_bound info.value info.mini) || 488 | (violates_max_bound info.value info.maxi)); (*15*) 489 | with Not_found -> assert false (*14*) 490 | 491 | ) env.fixme 492 | 493 | let _16__fixme_containts_basic_with_bad_values_if_not_unsat 494 | env all_vars result = 495 | match result with 496 | | Unsat _ | Unbounded _ | Max _ -> () 497 | | Unknown | Sat _ -> 498 | SX.iter 499 | (fun x -> 500 | if not (SX.mem x env.fixme) then 501 | let info = info_of x env in 502 | assert (not (violates_min_bound info.value info.mini)); 503 | assert (not (violates_max_bound info.value info.maxi)) 504 | )all_vars 505 | 506 | let _17__fixme_is_empty_if_not_unknown env result = 507 | match result with 508 | | Unknown -> () 509 | | Unsat _ | Sat _ | Unbounded _ | Max _ -> assert (SX.is_empty env.fixme) 510 | 511 | let _18__vals_of_basic_vars_computation env = 512 | MX.iter 513 | (fun _ ({value = s; _}, p) -> 514 | let vp = evaluate_poly env p in 515 | assert (R2.equal vp s); 516 | )env.basic 517 | 518 | let _19__check_that_vstatus_are_well_set env = 519 | let aux _ (info, _) = 520 | if info.empty_dom then 521 | assert (info.vstatus != ValueOK) 522 | else 523 | let vmin = violates_min_bound info.value info.mini in 524 | let vmax = violates_max_bound info.value info.maxi in 525 | match info.vstatus with 526 | | ValueOK -> assert (not vmin); assert(not vmax); 527 | | UpperKO -> assert (not vmin); assert(vmax); 528 | | LowerKO -> assert (vmin); assert(not vmax); 529 | in 530 | MX.iter aux env.basic; 531 | MX.iter aux env.non_basic 532 | 533 | let _20__bounds_are_consistent_if_not_unsat env result = 534 | match result with 535 | | Unsat _ -> () 536 | | Unknown | Sat _ | Unbounded _ | Max _ -> 537 | let aux _ (info, _) = assert (consistent_bounds info) in 538 | MX.iter aux env.basic; 539 | MX.iter aux env.non_basic 540 | 541 | let _21__check_coherence_of_empty_dom = 542 | let aux mx = 543 | MX.iter 544 | (fun _ (info, _) -> 545 | assert (consistent_bounds info == not info.empty_dom); 546 | if info.empty_dom then 547 | assert (violates_min_bound info.value info.mini || 548 | violates_max_bound info.value info.maxi); 549 | )mx 550 | in 551 | fun env -> 552 | aux env.non_basic; 553 | aux env.basic 554 | 555 | let check_invariants env get_result = 556 | if env.check_invs then 557 | let polys = get_all_polys env in 558 | let all_vars = get_all_vars env polys in 559 | let result = get_result env in 560 | _01__check_type env.is_int all_vars; 561 | _02__check_basic_non_basic_disjoint env; 562 | _03__check_vars_of_polys env polys; 563 | _04_05_06__check_use env; 564 | _07__values_ok_for_non_basic_vars env; 565 | _08_09__values_ok_when_sat env result; 566 | _10_11__check_handling_strict_ineqs env; 567 | _12__check_solution_when_sat env result; 568 | _13__check_reason_when_unsat env; 569 | _14_15__fixme_is_subset_of_basic env; 570 | _16__fixme_containts_basic_with_bad_values_if_not_unsat 571 | env all_vars result; 572 | _17__fixme_is_empty_if_not_unknown env result; 573 | _18__vals_of_basic_vars_computation env; 574 | _19__check_that_vstatus_are_well_set env; 575 | _20__bounds_are_consistent_if_not_unsat env result; 576 | (*_21__check_coherence_of_empty_dom env;*) 577 | 578 | 579 | end 580 | 581 | module Make 582 | (Var : Variables) 583 | (R : Rationals) 584 | (Ex : Explanations) 585 | : CoreSig.S with module Var=Var and type R.t = R.t and type V.t = R.t and module Ex=Ex = struct 586 | module V' = struct 587 | include R 588 | type r = t 589 | let mult_by_coef = mult 590 | let div_by_coef = div 591 | end 592 | include MakeExpert(Var)(R)(V')(Ex)(Rat2.Make(R)(V'))(Polys.Make(Var)(R)) 593 | (Map.Make(Var))(Set.Make(Var)) 594 | end 595 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | In the following, ocplib-simplex refers to all files marked "Copyright 2 | OCamlPro" in this distribution. 3 | 4 | ocplib-simplex is distributed under the terms of the GNU Lesser 5 | General Public License (LGPL) version 2.1 (included below). 6 | 7 | As a special exception to the GNU Lesser General Public License, you 8 | may link, statically or dynamically, a "work that uses ocplib-simplex" 9 | with a publicly distributed version of ocplib-simplex to produce an 10 | executable file containing portions of ocplib-simplex, and distribute 11 | that executable file under terms of your choice, without any of the 12 | additional requirements listed in clause 6 of the GNU Lesser General 13 | Public License. By "a publicly distributed version of ocplib-simplex", 14 | we mean either the unmodified ocplib-simplex as distributed by 15 | OCamlpro, or a modified version of ocplib-simplex that is distributed 16 | under the conditions defined in clause 2 of the GNU Lesser General 17 | Public License. This exception does not however invalidate any other 18 | reasons why the executable file might be covered by the GNU Lesser 19 | General Public License. 20 | 21 | ---------------------------------------------------------------------- 22 | 23 | GNU LESSER GENERAL PUBLIC LICENSE 24 | 25 | Version 2.1, February 1999 26 | 27 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 28 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 29 | Everyone is permitted to copy and distribute verbatim copies 30 | of this license document, but changing it is not allowed. 31 | 32 | [This is the first released version of the Lesser GPL. It also counts 33 | as the successor of the GNU Library Public License, version 2, hence 34 | the version number 2.1.] 35 | 36 | Preamble 37 | 38 | The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. 39 | 40 | This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. 41 | 42 | When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. 43 | 44 | To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. 45 | 46 | For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. 49 | 50 | To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. 51 | 52 | Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. 53 | 54 | Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. 55 | 56 | When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. 57 | 58 | We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. 59 | 60 | For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. 61 | 62 | In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. 63 | 64 | Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. 65 | 66 | The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. 67 | 68 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 69 | 70 | 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". 71 | 72 | A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. 73 | 74 | The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) 75 | 76 | "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. 77 | 78 | Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 79 | 80 | 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. 81 | 82 | You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 83 | 84 | 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: 85 | 86 | a) The modified work must itself be a software library. 87 | b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. 88 | c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. 89 | d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. 90 | 91 | (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) 92 | 93 | These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. 94 | 95 | Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. 96 | 97 | In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 98 | 99 | 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. 100 | 101 | Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. 102 | 103 | This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 104 | 105 | 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. 106 | 107 | If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 108 | 109 | 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. 110 | 111 | However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. 112 | 113 | When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. 114 | 115 | If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) 116 | 117 | Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 118 | 119 | 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. 120 | 121 | You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: 122 | 123 | a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) 124 | b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. 125 | c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. 126 | d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. 127 | e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. 128 | 129 | For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. 130 | 131 | It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 132 | 133 | 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: 134 | 135 | a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. 136 | b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 137 | 138 | 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 139 | 140 | 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 141 | 142 | 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 143 | 144 | 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. 145 | 146 | If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. 147 | 148 | It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. 149 | 150 | This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 151 | 152 | 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 153 | 154 | 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. 155 | 156 | Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 157 | 158 | 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. 159 | 160 | NO WARRANTY 161 | 162 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 163 | 164 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 165 | END OF TERMS AND CONDITIONS 166 | 167 | How to Apply These Terms to Your New Libraries 168 | 169 | If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). 170 | 171 | To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. 172 | 173 | one line to give the library's name and an idea of what it does. 174 | Copyright (C) year name of author 175 | 176 | This library is free software; you can redistribute it and/or 177 | modify it under the terms of the GNU Lesser General Public 178 | License as published by the Free Software Foundation; either 179 | version 2.1 of the License, or (at your option) any later version. 180 | 181 | This library is distributed in the hope that it will be useful, 182 | but WITHOUT ANY WARRANTY; without even the implied warranty of 183 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 184 | Lesser General Public License for more details. 185 | 186 | You should have received a copy of the GNU Lesser General Public 187 | License along with this library; if not, write to the Free Software 188 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 189 | 190 | Also add information on how to contact you by electronic and paper mail. 191 | 192 | You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: 193 | 194 | Yoyodyne, Inc., hereby disclaims all copyright interest in 195 | the library `Frob' (a library for tweaking knobs) written 196 | by James Random Hacker. 197 | 198 | signature of Ty Coon, 1 April 1990 199 | Ty Coon, President of Vice 200 | 201 | That's all there is to it! 202 | 203 | -------------------------------------------------- 204 | --------------------------------------------------------------------------------