diff --git a/.flake8 b/.flake8 new file mode 100644 index 0000000..61a9a47 --- /dev/null +++ b/.flake8 @@ -0,0 +1,3 @@ +[flake8] +max-line-length = 79 +exclude = .svn,CVS,.bzr,.hg,.git,__pycache__,.eggs,*.egg,*/_vendor/*,node_modules \ No newline at end of file diff --git a/.github/release-drafter.yml b/.github/release-drafter.yml new file mode 100644 index 0000000..e3f5a30 --- /dev/null +++ b/.github/release-drafter.yml @@ -0,0 +1,6 @@ +name-template: 'Version $RESOLVED_VERSION' +tag-template: '$RESOLVED_VERSION' +template: | + ## What's Changed + + $CHANGES \ No newline at end of file diff --git a/.github/workflows/pr.yml b/.github/workflows/pr.yml new file mode 100644 index 0000000..231b33b --- /dev/null +++ b/.github/workflows/pr.yml @@ -0,0 +1,55 @@ +name: Test on pull request + +on: + pull_request: + branches: [master] + +jobs: + lint: + name: Lint with flake8 + runs-on: ubuntu-latest + timeout-minutes: 5 + steps: + - uses: actions/checkout@v3 + - uses: actions/setup-python@v3 + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install flake8 + - name: Lint with flake8 + run: | + flake8 . + + test: + name: Test + runs-on: ${{ matrix.os }} + timeout-minutes: 15 + strategy: + fail-fast: true + matrix: + os: [ubuntu-latest, macos-latest, windows-latest] + python-version: ["3.10"] + steps: + - uses: actions/checkout@v3 + with: + fetch-depth: 0 + - name: Install Fortran compiler on Linux + if: contains(matrix.os, 'ubuntu') + run: | + sudo apt-get install -y gfortran + - name: Install Fortran compiler on MacOS + if: contains(matrix.os, 'macos') + run: | + brew unlink gcc && brew link gcc + - name: Set up Python ${{ matrix.python-version }} + uses: actions/setup-python@v3 + with: + python-version: ${{ matrix.python-version }} + - name: Install Python dependencies + run: | + python -m pip install --upgrade pip + pip install -e . -vv + pip install -r requirements-dev.txt + - name: Test with pytest + run: | + pytest -vv diff --git a/.github/workflows/push.yml b/.github/workflows/push.yml new file mode 100644 index 0000000..d7097bf --- /dev/null +++ b/.github/workflows/push.yml @@ -0,0 +1,68 @@ +name: Test, draft release and upload distribution to Test PyPi + +on: + push: + branches: [master] + +permissions: + contents: read + +jobs: + + test: + name: Test + runs-on: ${{ matrix.os }} + timeout-minutes: 15 + strategy: + fail-fast: true + matrix: + os: [ubuntu-latest, macos-latest, windows-latest] + python-version: ["3.10"] + steps: + - uses: actions/checkout@v3 + with: + fetch-depth: 0 + - name: Install Fortran compiler on Linux + if: contains(matrix.os, 'ubuntu') + run: | + sudo apt-get install -y gfortran + - name: Install Fortran compiler on MacOS + if: contains(matrix.os, 'macos') + run: | + brew unlink gcc && brew link gcc + - name: Set up Python ${{ matrix.python-version }} + uses: actions/setup-python@v3 + with: + python-version: ${{ matrix.python-version }} + - name: Install Python dependencies + run: | + python -m pip install --upgrade pip + pip install -e . -vv + pip install -r requirements-dev.txt + - name: Test with pytest + run: | + pytest -vv + + draft-release: + name: Draft release and upload distribution to Test PyPi + runs-on: ubuntu-latest + permissions: + contents: write + pull-requests: write + steps: + - uses: actions/checkout@v3 + with: + fetch-depth: 0 + - uses: actions/setup-python@v3 + - uses: release-drafter/release-drafter@v5 + env: + GITHUB_TOKEN: ${{ secrets.RELEASE_DRAFTER_PAT }} + - name: Build and upload distribution to Test PyPi + env: + TWINE_USERNAME: __token__ + TWINE_PASSWORD: ${{ secrets.TEST_PYPI_API_TOKEN }} + run: | + python -m pip install --upgrade pip + pip install build twine + python -m build --sdist --wheel --outdir dist/ . + twine upload -r testpypi dist/* diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml new file mode 100644 index 0000000..ab6c2dd --- /dev/null +++ b/.github/workflows/release.yml @@ -0,0 +1,24 @@ +name: Upload distribution to PyPi + +on: + release: + types: [published] + +jobs: + build-and-release: + name: Build and release + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v3 + with: + fetch-depth: 0 + - uses: actions/setup-python@v3 + - name: Build and upload distribution to PyPi + env: + TWINE_USERNAME: __token__ + TWINE_PASSWORD: ${{ secrets.PYPI_API_TOKEN }} + run: | + python -m pip install --upgrade pip + pip install build twine + python -m build --sdist --wheel --outdir dist/ . + twine upload dist/* diff --git a/.gitignore b/.gitignore index 232c0b1..1a3152b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,7 @@ # Custom +docs/*/*build* +notebooks/ +_version.py .DS_Store .vscode/ scripts/ diff --git a/.readthedocs.yml b/.readthedocs.yml new file mode 100644 index 0000000..1cd8cac --- /dev/null +++ b/.readthedocs.yml @@ -0,0 +1,23 @@ +# .readthedocs.yaml +# Read the Docs configuration file +# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details + +# Required +version: 2 + +# Set the version of Python and other tools you might need +build: + os: ubuntu-20.04 + tools: + python: "3.9" + +# Build documentation in the docs/ directory with Sphinx +sphinx: + builder: html + configuration: docs/source/conf.py + fail_on_warning: false + +# Optionally declare the Python requirements required to build your docs +python: + install: + - requirements: docs/requirements.txt diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index dfae99b..0000000 --- a/.travis.yml +++ /dev/null @@ -1,62 +0,0 @@ -language: python -python: -- '3.8' -os: -- linux -branches: - only: - - master -install: -- pip install -r requirements.txt -r requirements-dev.txt -before_script: -- python setup.py build_ext --inplace -script: pytest -v -jobs: - include: - - stage: test - - stage: release - install: skip - script: skip - python: '3.8' - before_deploy: - - export RELEASE_VERSION=$( cat VERSION ) - - git config --local user.name "jmyrberg" - - git config --local user.email "jesse.myrberg@gmail.com" - - git tag $RELEASE_VERSION - deploy: - provider: releases - name: Version $RELEASE_VERSION - tag_name: "$RELEASE_VERSION" - cleanup: false - prerelease: true - token: - secure: xl9JWhU7E5Am3aqK6ciulrMuSFmPRDh/P644NTg/xQRRX0DpMK/k8kCbzeE05ndzblfjtDKC7MUZEP+UydgGxb+9QcRI3ydY4TJWYkXBchEXfMvxJepRRtKn/pqP3f8/u/POIwT0Cgr4N+WdtTrXncLBUVpqPoeXjKURh+SAPEAmawB/lnD6mkjpWaPJEpVuQs8v7Rx9a4RIKXvzuY62VBZGJehpW70cZhlobxAxHfJ8ECJMXo49PVLmcdMdYfIB0VYtBYpphf1vejVExzRFNBd6n3UBJ4gUuI4sotjPRN/GEPv6H0yrbecMhE5xpZDGHmfklQx8ikbOeb3UNO7Ywsds12UfWBliMdOJhd17jeKDo6cErGThkVTqgWWjPuOhOpn4DW/2QL3CGR+ad42pHXBtjTxkX6QQjYx0zWPZRURvOip5yn2LWtunjSTBOxl/xbQfhM8nx0nUzYPX1btPHarXNveZFRMSGFeyhw/6BJHlbFt90syiOMbS2re0DAVFw//MYIs8XRZcyC9RMyYXPDtz///4eOfVdBHVxuYWBSYZuccRhwQlx6xfmHxcTsNUndPV50bd1EMkvCQb/qaR+mHQDJ7X2Beu9RUIeLw+pITBpL7FE6g24h5G8zV5tOXGMe4HfnmjV4DJRPvW/7u5hnlYwAYnNoE09egRW7yk5iw= - file: - - dist/*.tar.gz - file_glob: true - on: - branch: master - repo: jmyrberg/mknapsack - after_success: - - git push --tags - - stage: deploy - install: skip - script: skip - python: '3.8' - deploy: - provider: pypi - username: jmyrberg - distributions: sdist - cleanup: false - password: - secure: MzcXyXjE085HeL0JWU+4cEa+T7R+nICU4Gew+q+qkO1B8MVXpYZVhI4mveJ88oJC7m2CGbDLt5DcK5gUvfpEbEOoiNcnDSZhfBXuLarU9WWNrIREYM7pGhFM2WBi9Dr5gUhS6pWNMF55HaG6UDHtqTG/E95c5Ddqm3e5KcvAbfSshMC/9y0tFjnAMjjNaSOf/FtSJxxhipbIKRee2lXkPIkiPANNdZxUI3NGnLC5jpE+YnKk+2Go0ctqWH/y9wTCO5h33RBfGmKFsxy5I3n00KZYUgFAto8ysc54zRlFAKzCdCGF5Li1tQYz9MXMUg85ok/ohxsrwLVQsRh7A2Trg3hNtC48slQ9l1sq8CqpbGLnABZWTljp8qCJXOF6g2kXzMIjIHs2TXDYLU5XRZGp2jcS6uvLy3sRG21m42fJD/87N8PwfrgYc9G0BSgDzCkI1E5byEFJ6urVe4w/tBDjub0n6xyW8qWLZ/jBO9aQ9Cc/Ohmkt4Q+5u/TPpqjq4sexRNHwgrcSuBVkOcUqa66qHZEi7PvnvE/zqei7tw+rNgqWxrGAeeGnKHierJtJyKe42HVOJB6exltA/kHMdoT7Bw9NQGAmhHqJ/0WmnnJ3AOrcyM0yN/Gftr5AaLQF8nzOqV472N6M4AAQVCxLBzrqQkOhByLnxPRfXotNsy13Fs= - on: - branch: master - repo: jmyrberg/mknapsack -stages: -- name: test - if: type IN (pull_request, cron, api) -- name: release - if: type IN (push) -- name: deploy - if: type IN (push) \ No newline at end of file diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..ecdc597 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2022 Jesse Myrberg + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. \ No newline at end of file diff --git a/MANIFEST.in b/MANIFEST.in index 6c5a500..247fed6 100644 --- a/MANIFEST.in +++ b/MANIFEST.in @@ -1 +1,2 @@ -include VERSION cpp/** +recursive-include *.f +exclude .github diff --git a/README.md b/README.md index 98709fb..ebaea32 100644 --- a/README.md +++ b/README.md @@ -1,48 +1,55 @@ # mknapsack -[![Build Status](https://travis-ci.com/jmyrberg/mknapsack.svg?branch=master)](https://travis-ci.com/jmyrberg/mknapsack) +[![CICD](https://github.com/jmyrberg/mknapsack/actions/workflows/push.yml/badge.svg)](https://github.com/jmyrberg/mknapsack/actions/workflows/push.yml) +[![Documentation](https://readthedocs.org/projects/mknapsack/badge/?version=latest)](https://mknapsack.readthedocs.io/en/latest/?badge=latest) -Algorithms for solving the [Multiple 0-1 Knapsack Problem](http://www.or.deis.unibo.it/kp/Chapter6.pdf) (MKP). -Currently, only the [MTM algorithm by S. Martello and P. Toth (1981)](https://www.sciencedirect.com/science/article/pii/0166218X81900056) is implemented, -which guarantees an exact solution. This repository contains a Python interface to C++ implementation of the algorithm. +![mknapsack cover](https://github.com/jmyrberg/mknapsack/blob/master/docs/cover.png?raw=true) + +Algorithms for solving knapsack problems with Python: +* [Multiple 0-1 Knapsack Problem](http://www.or.deis.unibo.it/kp/Chapter6.pdf): MTM, MTHM + +This library provides a Python interface to the Fortran code from [Knapsack problems: algorithms and computer implementations](https://dl.acm.org/doi/book/10.5555/98124) by S. Martello and P. Toth, 1990. ## Installation -`pip install mknapsack` +1. Install Fortran compiler, if you don't already have + * MacOS / Linux: + `brew install gcc` + * Linux / Windows Subsystem for Linux: + `sudo apt-get install gfortran` + * Windows (experimental) + * Option 1): + `conda install -c conda-forge m2w64-toolchain_win-64` + * Option 2): + [Install MSYS2](https://www.msys2.org) and run + `pacman -S --needed base-devel mingw-w64-x86_64-toolchain` + +2. `pip install -U mknapsack` ## Example usage -Given ten items with the following profits and weights: +### Multiple 0-1 Knapsack Problem ```python +from mknapsack import solve_multiple_knapsack + +# Given ten items with the following profits and weights: profits = [78, 35, 89, 36, 94, 75, 74, 79, 80, 16] weights = [18, 9, 23, 20, 59, 61, 70, 75, 76, 30] -``` - -and two knapsacks with the following capacities: -```python +# ...and two knapsacks with the following capacities: capacities = [90, 100] -``` - -How should we assign these items to knapsacks in order to maximize the profit? - -```python -from mknapsack.algorithms import mtm -z, x, bt, glopt = mtm(profits, weights, capacities) -print('Total profit: %d' % z) -print('Solution: %s' % x) -print('Number of backtracks performed: %d' % bt) -print('Global optimum: %s' % glopt) +# Assign items into knapsacks while maximizing profit +res = solve_multiple_knapsack(profits, weights, capacities) ``` ## References -* [MTM algorithm by Martello and Toth](http://people.sc.fsu.edu/~jburkardt/f77_src/knapsack/knapsack.f) (Fortran) -* [MTHM and MTHG algorithms by Jeff Hetherly](https://github.com/jhetherly/python_knapsack) (Python) +* [Knapsack problems: algorithms and computer implementations](https://dl.acm.org/doi/book/10.5555/98124) by S. Martello and P. Toth, 1990 +* [Fortran77 source code](http://people.sc.fsu.edu/~jburkardt/f77_src/knapsack/knapsack.f) by S. Martello and P. Toth --- Jesse Myrberg (jesse.myrberg@gmail.com) \ No newline at end of file diff --git a/VERSION b/VERSION deleted file mode 100644 index f9cbc01..0000000 --- a/VERSION +++ /dev/null @@ -1 +0,0 @@ -1.0.7 \ No newline at end of file diff --git a/cover.png b/cover.png new file mode 100644 index 0000000..f57ca0b Binary files /dev/null and b/cover.png differ diff --git a/cpp/main.cpp b/cpp/main.cpp deleted file mode 100644 index be14ca3..0000000 --- a/cpp/main.cpp +++ /dev/null @@ -1,53 +0,0 @@ -#include -#include "mtm_c.h" - - -using namespace mtm; - - -int main() { - /* - std::vector profits = {78, 35, 89, 36, 94, 75, 74, 79, 80, 16, 15, 15}; - std::vector weights = {18, 9, 23, 20, 59, 61, 70, 75, 76, 30, 40, 40}; - std::vector capacities = {82, 85, 87, 100}; - MTMSolver MTM(profits, weights, capacities); - MTM.solve(); - std::cout << std::endl << std::endl; - - std::vector profits2 = {78, 35, 89, 36, 94, 75, 74, 79, 80, 16}; - std::vector weights2 = {18, 9, 23, 20, 59, 61, 70, 75, 76, 30}; - std::vector capacities2 = {103, 130, 140}; - MTMSolver MTM2(profits2, weights2, capacities2); - MTM2.solve(); - std::cout << std::endl << std::endl; - - std::vector profits3 = {78, 78, 35, 35, 89, 89, 36, 36, 94, 94, 75, 75, 74, 74, 79, 79, 80, 80, 16, 16, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1}; - std::vector weights3 = {18, 18, 9, 9, 23, 23, 20, 20, 59, 59, 61, 61, 70, 70, 75, 75, 76, 76, 30, 30, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49}; - std::vector capacities3 = {80, 90, 100, 110}; - MTMSolver MTM3(profits3, weights3, capacities3); - MTM3.solve(); - std::cout << std::endl << std::endl; -*/ - std::vector profits4 = {78, 77, 35, 34, 89, 88, 36, 35, 94, 93, 75, 74, 74, 73, 79, 78, 80, 79, 16, 15, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1}; - std::vector weights4 = {18, 18, 9, 9, 23, 23, 20, 20, 59, 59, 61, 61, 70, 70, 75, 75, 76, 76, 30, 30, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49}; - std::vector capacities4 = {80, 90, 100, 110}; - MTMSolver MTM4(profits4, weights4, capacities4); - MTM4.solve(); - std::cout << std::endl << std::endl; -/* - std::vector profits5 = {78, 35, 89, 36, 94, 75, 74, 79, 80, 16}; - std::vector weights5 = {18, 9, 23, 20, 59, 61, 70, 75, 76, 30}; - std::vector capacities5 = {76, 110, 112}; - MTMSolver MTM5(profits5, weights5, capacities5); - MTM5.solve(); - std::cout << std::endl << std::endl; - - std::vector profits6 = {63, 66, 65, 64, 64, 64, 64, 63, 64, 65, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6}; - std::vector weights6 = {420, 510, 510, 420, 420, 390, 420, 510, 420, 510, 270, 300, 330, 360, 390, 420, 450, 480, 510, 540, 570, 600}; - std::vector capacities6 = {1320, 1320, 1320, 1320}; - MTMSolver MTM6(profits6, weights6, capacities6); - MTM6.solve(); - std::cout << std::endl << std::endl; -*/ - return 0; -} diff --git a/cpp/mtm_c.cpp b/cpp/mtm_c.cpp deleted file mode 100644 index 7e22454..0000000 --- a/cpp/mtm_c.cpp +++ /dev/null @@ -1,494 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include "mtm_c.h" - - -namespace mtm { - - -int max(int a, int b) { - return a > b ? a : b; -} - - -std::tuple> SolveSingleKnapsack(std::vector profits, std::vector weights, int capacity, int n_items) { - - std::vector p = profits; - std::vector w = weights; - int c = capacity; - int n = n_items; - - // Impossible cases - std::vector picked(n,0); - if ((c == 0) || (n == 0)) - return std::make_tuple(0, picked); - - // Remove items where weight > capacity - int j; - std::vector idx2j(n); - for (j = 0; j < n; j++) - idx2j[j] = j; - if (*std::max_element(w.begin(), w.end()) > c) { - p = {}; - w = {}; - int cnt = 0; - for (j = 0; j < n; j++) - if (weights[j] <= c) { - p.push_back(profits[j]); - w.push_back(weights[j]); - idx2j[cnt] = j; - cnt++; - } - n = cnt; - if (n == 0) - return std::make_tuple(0, picked); - } - - // Run algorithm - int i, k; - std::vector K((n+1)*(c+1)); - - // Build DP table - for (i = 0; i <= n; i++) { - K[i*(c+1) + 0] = 0; - } - for (k = 0; k <= c; k++) - K[0*(c+1) + k] = 0; - for (i = 1; i <= n; i++) - for (k = 1; k <= c; k++) - K[i*(c+1) + k] = (w[i-1] <= k) ? max(p[i-1] + K[(i-1)*(c+1) + k-w[i-1]], K[(i-1)*(c+1) + k]) : K[(i-1)*(c+1) + k]; - - // Get picked up items as a vector - int wn; - i = n; - k = c; - while (i > 0) { - wn = k - w[i-1]; - if (wn >= 0) { - if (K[i*(c+1) + k] - K[(i-1)*(c+1) + wn] == p[i-1]) { - i--; - k -= w[i]; - picked[idx2j[i]] = 1; - } else { - i--; - picked[idx2j[i]] = 0; - } - } else { - i--; - } - } - return std::make_tuple(K[n*(c+1) + c], picked); -} - - -MTMSolver::MTMSolver(std::vector profits, std::vector weights, std::vector capacities, int max_backtracks, int max_time) { - p = profits; - w = weights; - c = capacities; - - glopt = true; - - n = profits.size(); - m = capacities.size(); - z = 0; - i = 0; - L = 0; - U = 0; - Ur = 0; - bt = 0; - btl = max_backtracks; - tl = max_time; - ph = 0; - - Ul = 0; - il = 0; - - x.resize(n); - cr.resize(m); - jhuse.resize(n); - Uj.resize(n); - - xh.resize(n*m); - xt.resize(n*m); - xl.resize(n); - xr.resize(n); - - int ct = 0; - for (int k = 0; k < m; k++) { - cr[k] = c[k]; - cl += c[k]; - ct += c[k]; - - S[k] = {}; - } - for (int j = 0; j < n; j++) { - x[j] = -1; - jhuse[j] = 0; - Uj[j] = -1; - } - - auto sol = SolveSingleKnapsack(p, w, ct, n); - U = std::get<0>(sol); - xr = std::get<1>(sol); - Ur = U; -} - - -void MTMSolver::ParametricUpperBound() { - int k,j,kq; - bool calc_ub = true; - - // Last solution - while (true) { - - // Condition (1) - bool condl1 = true; - for (k = il; k <= i; k++) - for (j = 0; j < n; j++) - if ((xh[k*n + j] == 1) && (xl[j] == 0)) { - condl1 = false; - break; - } - - // Condition (2) - kq = 0; - for (k = il; k < i; k++) - kq += cr[k]; - bool condl2 = (cl >= kq) ? true : false; - - // Use previous upper bound from last solution? - if (condl1 && condl2) { - U = Ul; - calc_ub = false; - } - break; - } - - // Root solution - while (true && calc_ub) { - - // Condition (1) - bool condr1 = true; - for (k = 0; k <= i; k++) - for (j = 0; j < n; j++) - if ((xh[k*n + j] == 1) && (xr[j] == 0)) { - condr1 = false; - break; - } - - // Condition (2) - kq = 0; - for (k = 0; k < i; k++) - kq += cr[k]; - bool condr2 = (cl >= kq) ? true : false; - - // Use previous upper bound from last solution? - if (condr1 && condr2) { - U = Ur; - calc_ub = false; - } - break; - } - - // Calculate new upper bound - if (calc_ub) - UpperBound(); -} - - -void MTMSolver::UpperBound() { - int k,j; - - // // Profits and weights of remaining items - int n_ = 0; - for (j = 0; j < n; j++) - n_ += 1 - jhuse[j]; - std::vector N_(n_),p_(n_),w_(n_); - int cnt = 0; - int wt = 0; - int pt = 0; - for (j = 0; j < n; j++) { - if (jhuse[j] == 0) { - N_[cnt] = j; - p_[cnt] = p[j]; - w_[cnt] = w[j]; - wt += w[j]; - pt += p[j]; - cnt++; - } - } - - // Remaining capacity - int c_ = (*std::min_element(w_.begin(), w_.end()) > cr[i]) ? 0 : cr[i]; - for (k = i+1; k < m; k++) - c_ += cr[k]; - - // Solve knapsack, if maximum available profit exceeds current best profit - U = ph; - std::vector xtt(n_); - std::fill(xl.begin(), xl.end(), 0); - if (wt > c_) { - auto sol = SolveSingleKnapsack(p_, w_, c_, n_); - int z_ = std::get<0>(sol); - xtt = std::get<1>(sol); - U += z_; - - cl = c_; - cnt = 0; - for (auto jit = N_.begin(); jit != N_.end(); jit++) { - xl[*jit] = xtt[cnt]; - if (xtt[cnt] == 1) - cl -= w_[cnt]; - cnt++; - } - } else { - for (auto jit = N_.begin(); jit != N_.end(); jit++) - xl[*jit] = 1; - U += pt; - cl = c_ - wt; - } - Ul = U; - il = i; -} - - -void MTMSolver::LowerBound() { - int k,j; - - // Total profit for current solution - L = ph; - - // Remaining items - std::list Nd,N_; - std::list Si = S[i]; - std::list::iterator jit,fit; - for (j = 0; j < n; j++) - if (jhuse[j] == 0) - Nd.push_back(j); - for (jit = Nd.begin(); jit != Nd.end(); jit++) { - fit = std::find(Si.begin(), Si.end(), *jit); - if (!(fit != Si.end())) - N_.push_back(*jit); - } - - // Remaining capacity - int c_ = cr[i]; - - // Initialize solution - std::fill(xt.begin(), xt.end(), 0); - - k = i; - - int n_,z_,cnt; - std::vector p_,w_,xtt; - while (k < m) { - - // Update profits and weights - n_ = N_.size(); - p_.resize(n_); - w_.resize(n_); - cnt = 0; - for (jit = N_.begin(); jit != N_.end(); jit++) { - p_[cnt] = p[*jit]; - w_[cnt] = w[*jit]; - cnt++; - } - - auto sol = SolveSingleKnapsack(p_, w_, c_, n_); - z_ = std::get<0>(sol); - xtt = std::get<1>(sol); - - // Update solution for knapsack k - cnt = 0; - for (jit = N_.begin(); jit != N_.end(); jit++) { - xt[k*n + (*jit)] = xtt[cnt]; - cnt++; - } - L += z_; - - // Remove solution items - for (j = 0; j < n; j++) - if (xt[k*n + j] == 1) - Nd.remove(j); - N_ = Nd; - - k++; - - // Update capacity - if (k < m) - c_ = c[k]; - } -} - - -std::vector MTMSolver::solve() { - int k,l,j; - std::list Si,I; - bool heuristic,update,backtrack,stop_update; - - clock_t start = clock() / CLOCKS_PER_SEC; - clock_t point = clock() / CLOCKS_PER_SEC; - - heuristic = true; - while (heuristic) { - - // HEURISTIC - update = true; - backtrack = true; - - LowerBound(); - - // Current solution is better than any previous - if (L > z) { - - // Update new solution value z and solution x - z = L; - for (j = 0; j < n; j++) - x[j] = -1; - for (k = 0; k < m; k++) - for (j = 0; j < n; j++) - x[j] = (xh[k*n + j] == 1) ? k : x[j]; - for (k = i; k < m; k++) - for (j = 0; j < n; j++) - if (xt[k*n + j] == 1) - x[j] = k; - - // Optimal solution has been found globally - if (z == Ur) { - break; // stop search - } - - // Best solution has been found for the current node - if (z == U) { - backtrack = true; - update = false; // go to backtrack - } - } - - // UPDATE - if (update) { - stop_update = false; - while (i < m - 1) { - - // Add previous LB solution to node candidates - I = {}; - for (l = 0; l < n; l++) - if (xt[i*n + l] == 1) - I.push_back(l); - - while (I.size() > 0) { - j = *std::min_element(I.begin(), I.end()); - I.remove(j); - - // Add item j to current solution - S[i].push_back(j); - xh[i*n + j] = 1; - cr[i] -= w[j]; - ph += p[j]; - jhuse[j] = 1; - Uj[j] = U; - - ParametricUpperBound(); - - // Current solution cannot be better than the best solution so far - if (U <= z) { - break; // go to backtrack - } - } - if (stop_update) - break; - else - i++; - } - if ((i == m - 1) && (!stop_update)) - i = m - 2; - } - - // BACKTRACK - if (backtrack) { - point = clock() / CLOCKS_PER_SEC; - if (point - start > tl) { // Time is up! - glopt = false; - heuristic = false; - break; - } - heuristic = false; - backtrack = false; - bt++; - if (bt == btl) { - glopt = false; - break; - } - while (i >= 0) { - while (S[i].size() > 0) { - j = S[i].back(); - - // Backtracking was called with item not in the current solution - if (xh[i*n + j] == 0) { - S[i].pop_back(); - } else { - - // Remove j from current solution - xh[i*n + j] = 0; - cr[i] += w[j]; - ph -= p[j]; - jhuse[j] = 0; - - U = Uj[j]; - - // Current solution is better than the best solution so far - if (U > z) { - heuristic = true; // go to heuristic - break; - } - } - - } - if (heuristic) - break; - else { - i--; - il -= 1; - } - } - } - } // heuristic - - std::vector res(n+3); - for (j = 0; j < n+3; j++) { - if (j < n) - res[j] = x[j]; - else if (j == n) - res[j] = glopt; - else if (j == n+1) - res[j] = z; - else - res[j] = bt; - } - - /*std::vector ksack_weights(m); - for (k = 0; k < m; k++) - ksack_weights[k] = 0; - std::cout << "x ="; - for (j = 0; j < n; j++) { - std::cout << " " << x[j]+1; - k = x[j]; - if (k != -1) { - ksack_weights[k] += w[j]; - } - } - std::cout << std::endl; - for (k = 0; k < m; k++) { - std::cout << "k[" << k+1 << "] = " << ksack_weights[k] << " / " << c[k] << std::endl; - } - std::cout << "SOLUTION = " << z << std::endl; - std::cout << "BACKTRACKS = " << bt << std::endl; - std::cout << "BACKTRACKS = " << btl << std::endl;*/ - return res; -} -} // namespace diff --git a/cpp/mtm_c.h b/cpp/mtm_c.h deleted file mode 100644 index 3d0ec9f..0000000 --- a/cpp/mtm_c.h +++ /dev/null @@ -1,67 +0,0 @@ -#ifndef MTM_C_H -#define MTM_C_H - -#include -#include -#include - - -namespace mtm { - - -class MTMSolver { - /* Solves the Multiple 0-1 Knapsack Problem (MKP) with MTM algorithm. - - Implementation reference: - S. Martello, P. Toth - A Bound and Bound algorithm for the zero-one multiple knapsack problem - Discrete Applied Mathematics, 3 (1981), pp. 257-288 - */ - private: - - std::vector p; // Item profits - std::vector w; // Item weights - std::vector c; // Item capacities - - int n; // Number of items - int m; // Number of knapsacks - int bt; // Number of backtracks performed - int btl; // Maximum number of backtracks to perform - int tl; // Maximum number of seconds to run the algorithm - - std::vector xh; // Current solution - int z; // Current best solution value - int i; // Current knapsack - int L; // Lower bound for current solution - int U; // Upper bound for current solution - int ph; // Total profit of current solution - std::vector cr; // Knapsack residual capacities for current solution - - int Ur; // Upper bound at root node - std::vector xr; // Root solution (parametric upper bound) - - int Ul; // Upper bound of last solution (parametric upper bound) - int il; // Knapsack considered in last solution (parametric upper bound) - std::vector xl; // Last current solution (parametric upper bound) - int cl; // Residual capacity of last solution (parametric upper bound) - - std::vector x; // Current best solution (knapsack for each item) - std::vector xt; // Latest solution calculated in lower bound - - std::map > S; // Unlabeled (=assigned) items for each knapsack - std::vector jhuse; // Whether an item is assigned to a knapsack - std::vector Uj; // Upper bound of father node before setting xh[i][j] = 1 - - bool glopt; // Indicates whether current solution is guaranteed to be global optimum or not - - void ParametricUpperBound(); // Compute parametric upper bound, if possible - void UpperBound(); // Compute upper bound - void LowerBound(); // Compute lower bound - - public: - MTMSolver(std::vector profits, std::vector weights, std::vector capacities, int max_backtracks = -1, int max_time = 3600); - std::vector solve(); // Run the algorithm -}; -} - -#endif diff --git a/docs/Makefile b/docs/Makefile new file mode 100644 index 0000000..d0c3cbf --- /dev/null +++ b/docs/Makefile @@ -0,0 +1,20 @@ +# Minimal makefile for Sphinx documentation +# + +# You can set these variables from the command line, and also +# from the environment for the first two. +SPHINXOPTS ?= +SPHINXBUILD ?= sphinx-build +SOURCEDIR = source +BUILDDIR = build + +# Put it first so that "make" without argument is like "make help". +help: + @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) + +.PHONY: help Makefile + +# Catch-all target: route all unknown targets to Sphinx using the new +# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). +%: Makefile + @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) diff --git a/docs/make.bat b/docs/make.bat new file mode 100644 index 0000000..747ffb7 --- /dev/null +++ b/docs/make.bat @@ -0,0 +1,35 @@ +@ECHO OFF + +pushd %~dp0 + +REM Command file for Sphinx documentation + +if "%SPHINXBUILD%" == "" ( + set SPHINXBUILD=sphinx-build +) +set SOURCEDIR=source +set BUILDDIR=build + +%SPHINXBUILD% >NUL 2>NUL +if errorlevel 9009 ( + echo. + echo.The 'sphinx-build' command was not found. Make sure you have Sphinx + echo.installed, then set the SPHINXBUILD environment variable to point + echo.to the full path of the 'sphinx-build' executable. Alternatively you + echo.may add the Sphinx directory to PATH. + echo. + echo.If you don't have Sphinx installed, grab it from + echo.https://www.sphinx-doc.org/ + exit /b 1 +) + +if "%1" == "" goto help + +%SPHINXBUILD% -M %1 %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% +goto end + +:help +%SPHINXBUILD% -M help %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% + +:end +popd diff --git a/docs/requirements.txt b/docs/requirements.txt new file mode 100644 index 0000000..62178fb --- /dev/null +++ b/docs/requirements.txt @@ -0,0 +1,3 @@ +myst-parser==0.18.0 +piccolo-theme==0.11.1 +sphinx==5.0.2 \ No newline at end of file diff --git a/docs/source/conf.py b/docs/source/conf.py new file mode 100644 index 0000000..a66f718 --- /dev/null +++ b/docs/source/conf.py @@ -0,0 +1,80 @@ +# Configuration file for the Sphinx documentation builder. +# +# This file only contains a selection of the most common options. For a full +# list see the documentation: +# https://www.sphinx-doc.org/en/master/usage/configuration.html + +# -- Path setup -------------------------------------------------------------- + +# If extensions (or modules to document with autodoc) are in another directory, +# add these directories to sys.path here. If the directory is relative to the +# documentation root, use os.path.abspath to make it absolute, like shown here. +# +import os +import sys + +from setuptools_scm import get_version + +sys.path.insert(0, os.path.abspath('../../')) + + +# -- Project information ----------------------------------------------------- + +project = 'mknapsack' +copyright = '2022, Jesse Myrberg' +author = 'Jesse Myrberg' + +# The full version, including alpha/beta/rc tags +release = get_version('../../') +if '+' in release: + release = release.split('+')[0] + + +# -- General configuration --------------------------------------------------- + +# Add any Sphinx extension module names here, as strings. They can be +# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom +# ones. +extensions = [ + 'myst_parser', + 'sphinx.ext.napoleon' +] + +# Napoleon settings +napoleon_google_docstring = True +napoleon_numpy_docstring = False +napoleon_include_init_with_doc = False +napoleon_include_private_with_doc = False +napoleon_include_special_with_doc = True +napoleon_use_admonition_for_examples = False +napoleon_use_admonition_for_notes = False +napoleon_use_admonition_for_references = False +napoleon_use_ivar = False +napoleon_use_param = True +napoleon_use_rtype = True +napoleon_preprocess_types = False +napoleon_type_aliases = None +napoleon_attr_annotations = True + +# Add any paths that contain templates here, relative to this directory. +templates_path = ['_templates'] + +# List of patterns, relative to source directory, that match files and +# directories to ignore when looking for source files. +# This pattern also affects html_static_path and html_extra_path. +exclude_patterns = [] + +source_suffix = ['.rst', '.md'] + + +# -- Options for HTML output ------------------------------------------------- + +# The theme to use for HTML and HTML Help pages. See the documentation for +# a list of builtin themes. +# +html_theme = 'piccolo_theme' + +# Add any paths that contain custom static files (such as style sheets) here, +# relative to this directory. They are copied after the builtin static files, +# so a file named "default.css" will overwrite the builtin "default.css". +html_static_path = ['_static'] diff --git a/docs/source/index.rst b/docs/source/index.rst new file mode 100644 index 0000000..40e219e --- /dev/null +++ b/docs/source/index.rst @@ -0,0 +1,19 @@ +.. mknapsack documentation master file, created by + sphinx-quickstart on Thu Jul 21 23:07:08 2022. + You can adapt this file completely to your liking, but it should at least + contain the root `toctree` directive. + +.. include:: readme.rst + +.. toctree:: + :caption: Documentation + :maxdepth: 2 + + Getting started + + +.. toctree:: + :caption: API + :maxdepth: 4 + + mknapsack diff --git a/docs/source/mknapsack.rst b/docs/source/mknapsack.rst new file mode 100644 index 0000000..b3fc907 --- /dev/null +++ b/docs/source/mknapsack.rst @@ -0,0 +1,10 @@ +mknapsack package +================= + +Module contents +--------------- + +.. automodule:: mknapsack + :members: + :undoc-members: + :show-inheritance: diff --git a/docs/source/readme.rst b/docs/source/readme.rst new file mode 100644 index 0000000..519ef15 --- /dev/null +++ b/docs/source/readme.rst @@ -0,0 +1,2 @@ +.. include:: ../../README.md + :parser: myst_parser.sphinx_ \ No newline at end of file diff --git a/mknapsack/__init__.py b/mknapsack/__init__.py new file mode 100644 index 0000000..dbec598 --- /dev/null +++ b/mknapsack/__init__.py @@ -0,0 +1,14 @@ +__all__ = ['solve_multiple_knapsack'] + +import os +import sys + + +# .libs -folder must be added to dll for Windows and Python >=3.8 +# https://github.com/numpy/numpy/issues/14923 +extra_dll_dir = os.path.join(os.path.dirname(__file__), '.libs') +if sys.platform == 'win32' and os.path.isdir(extra_dll_dir): + os.add_dll_directory(extra_dll_dir) + + +from mknapsack._multiple import solve_multiple_knapsack # noqa: E402 diff --git a/mknapsack/_algos.f b/mknapsack/_algos.f new file mode 100644 index 0000000..c00c531 --- /dev/null +++ b/mknapsack/_algos.f @@ -0,0 +1,12416 @@ + subroutine bld ( n6, ss, il, ir, ii, nxt, nlr ) + +c*********************************************************************72 +c +cc BLD explicitly determines set a - a1 or set a - a1 - a2 when lev .gt. 1 . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + dimension ss(n6) + + j = il - 1 + next = nxt + + do i=il,ii,7 + ik = ss(next) + 1. + i6 = i + 6 + do ij=ik,i6 + j = j + 1 + ss(j) = ss(ij) + end do + next = next + 1 + end do + + irr = ii + 7 + nlr + + do ij=irr,ir + j = j + 1 + ss(j) = ss(ij) + end do + + return + end + subroutine bldf(n,s,n6,ss,il,ir,nlr) + +c*********************************************************************72 +c +cc BLDF explicitly determines set a1 or set a - a1 or set a - a1 - a2 when lev .eq. 1 . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + dimension s(n) + dimension ss(n6) + + nn7 = (ir - il + 1)/7 + ics = 1 + icd = nn7 + 1 + ius = il + 6 + ips = ss(1) + 1. + iud = il + 7*nn7 + ipd = iud + nlr - 1 + + 10 if ( ips .le. ius ) go to 20 + ics = ics + 1 + if ( ics .eq. icd ) return + ius = ius + 7 + ips = ss(ics) + 1 + go to 10 + + 20 if ( ipd .ge. iud ) go to 30 + icd = icd - 1 + if ( icd .eq. ics ) return + iud = iud - 7 + ipd = ss(icd) + go to 20 + + 30 ap = s(ips) + s(ips) = s(ipd) + s(ipd) = ap + ips = ips + 1 + ipd = ipd - 1 + go to 10 + + end + subroutine blds1(n6,ss,il,ii,nxt,nlr) + +c*********************************************************************72 +c +cc BLDSR1 explicitly determines set A1 when 1 < LEV. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + dimension ss(n6) + + j = il - 1 + next = nxt + + do i=il,ii,7 + + ik = ss(next) + + do ij=i,ik + j = j + 1 + ss(j) = ss(ij) + end do + next = next + 1 + + end do + + ik = ii + 7 + irr = ik + nlr - 1 + + do ij=ik,irr + j = j + 1 + ss(j) = ss(ij) + end do + + return + end + subroutine chmt1(n,p,w,c,z,jdim) + +c*********************************************************************72 +c +cc CHMT1 checks the input data for MT1. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer c + integer p(jdim) + integer w(jdim) + integer z + + if ( n .lt. 2 .or. jdim - 1 .lt. n ) then + z = - 1 + return + end if + + if ( c .gt. 0 ) go to 30 + 20 z = - 2 + return + 30 jsw = 0 + rr = float(p(1))/float(w(1)) + + do 50 j=1,n + r = rr + if ( p(j) .le. 0 ) go to 20 + if ( w(j) .le. 0 ) go to 20 + jsw = jsw + w(j) + if ( w(j) .le. c ) go to 40 + z = - 3 + return + 40 rr = float(p(j))/float(w(j)) + if ( rr .le. r ) go to 50 + z = - 5 + return + 50 continue + + if ( jsw .gt. c ) return + z = - 4 + + return + end + subroutine chmt1r(n,p,w,c,z,jdim) + +c*********************************************************************72 +c +cc CHMT1R checks the input data for MT1R. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer jdim + + real jsw + real p(jdim) + real w(jdim) + + if ( n .lt. 2 .or. n .gt. jdim - 1 ) then + z = - 1.0 + return + end if + + if ( c .le. 0.0 ) then + z = - 2.0 + return + end if + + jsw = 0.0 + rr = p(1) / w(1) + + do j = 1, n + + r = rr + + if ( p(j) .le. 0. ) then + z = - 2.0 + return + end if + + if ( w(j) .le. 0. ) then + z = - 2.0 + return + end if + + jsw = jsw + w(j) + + if ( w(j) .gt. c ) then + z = - 3. + return + end if + + rr = p(j)/w(j) + + if ( rr .gt. r ) then + z = - 5. + return + end if + + end do + + if ( jsw .le. c ) then + z = - 4.0 + end if + + return + end + subroutine chmt2(n,p,w,c,jfs,z,jdim) + +c*********************************************************************72 +c +cc CHMT2 checks the input data for MT2. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer c + integer p(jdim),w(jdim),z + + if ( n .ge. 2 .and. n .le. jdim - 3 ) go to 10 + z = - 1 + return + 10 if ( c .gt. 0 ) go to 30 + 20 z = - 2 + return + 30 jsw = 0 + do 40 j=1,n + if ( p(j) .le. 0 ) go to 20 + if ( w(j) .le. 0 ) go to 20 + jsw = jsw + w(j) + if ( w(j) .le. c ) go to 40 + z = - 3 + return + 40 continue + if ( jsw .gt. c ) go to 50 + z = - 4 + return + 50 if ( jfs .eq. 0 ) return + rr = float(p(1))/float(w(1)) + do 60 j=2,n + r = rr + rr = float(p(j))/float(w(j)) + if ( rr .gt. r ) go to 70 + 60 continue + return + 70 z = - 5 + return + end + subroutine chmtb2(n,p,w,b,c,jfs,z,jdim1) + +c*********************************************************************72 +c +cc CHMTB2 checks the input data for MTB2. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer c + integer p(jdim1),w(jdim1),b(jdim1),z + + if ( n .gt. 1 .and. n .le. jdim1 - 1 ) go to 10 + z = - 1 + return + 10 if ( c .gt. 0 ) go to 30 + 20 z = - 2 + return + 30 jsw = 0 + do 40 j=1,n + if ( p(j) .le. 0 ) go to 20 + if ( w(j) .le. 0 ) go to 20 + if ( b(j) .le. 0 ) go to 20 + jsw = jsw + b(j)*w(j) + if ( b(j)*w(j) .gt. c ) go to 50 + 40 continue + if ( jsw .gt. c ) go to 60 + z = - 4 + return + 50 z = - 3 + return + 60 if ( jfs .eq. 0 ) return + rr = float(p(1))/float(w(1)) + do 70 j=2,n + r = rr + rr = float(p(j))/float(w(j)) + if ( rr .gt. r ) go to 80 + 70 continue + return + 80 z = - 6 + return + end + subroutine chmtc2(n,w,c,z,jdn) + +c*********************************************************************72 +c +cc CHMTC2 checks the input data for MTC2. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer c + integer w(jdn),z + + if ( n .ge. 2 .and. n .le. jdn - 1 ) go to 10 + z = - 1 + return + 10 if ( c .gt. 0 ) go to 30 + 20 z = - 2 + return + 30 do 40 j=1,n + if ( w(j) .le. 0 ) go to 20 + if ( w(j) .ge. c ) go to 50 + 40 continue + return + 50 z = - 3 + return + end + subroutine chmtcb(n,w,b,c,z,jdn) + +c*********************************************************************72 +c +cc CHMTCB checks the input data for MTCB. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdn),b(jdn),c,z + + if ( n .ge. 2 .and. n .le. jdn - 1 ) go to 10 + z = - 1 + return + 10 if ( c .gt. 0 ) go to 30 + 20 z = - 2 + return + 30 jsum = 0 + do 40 j=1,n + if ( w(j) .le. 0 ) go to 20 + if ( b(j) .le. 0 ) go to 20 + if ( w(j) .ge. c ) go to 50 + if ( b(j)*w(j) .gt. c ) go to 60 + jsum = jsum + b(j)*w(j) + 40 continue + if ( jsum .le. c ) go to 70 + return + 50 z = - 3 + return + 60 z = - 4 + return + 70 z = - 5 + return + end + subroutine chmtg(n,m,p,w,c,jdimr,jdimc,jdimpc,z) + +c*********************************************************************72 +c +cc CHMTG checks the input data for MTG. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),c(jdimr),z + + if ( m .le. 1 ) z = - 1 + if ( m .gt. jdimr ) z = - 1 + if ( z .lt. 0 ) return + if ( n .le. 1 ) z = - 2 + if ( n .gt. jdimc ) z = - 2 + if ( z .lt. 0 ) return + if ( m .le. jdimpc) go to 10 + z = - 3 + return + 10 do 50 i=1,m + if ( c(i) .gt. 0 ) go to 20 + z = - 4 + return + 20 min = c(i) + 1 + do 40 j=1,n + if ( p(i,j) .gt. 0 .and. w(i,j) .gt. 0 ) go to 30 + z = - 4 + return + 30 if ( w(i,j) .lt. min ) min = w(i,j) + 40 continue + if ( c(i) .lt. min ) z = - 6 + 50 continue + do 70 j=1,n + do 60 i=1,m + if ( w(i,j) .le. c(i) ) go to 70 + 60 continue + z = - 5 + return + 70 continue + return + end + subroutine chmthg(n,m,p,w,c,jdimr,jdimc,z) + +c*********************************************************************72 +c +cc CHMTHG checks the input data for MTHG. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),c(jdimr),z + + if ( m .le. 1 ) z = - 1 + if ( m .gt. jdimr ) z = - 1 + if ( z .lt. 0 ) return + if ( n .le. 1 ) z = - 2 + if ( n .gt. jdimc ) z = - 2 + if ( z .lt. 0 ) return + do 40 i=1,m + if ( c(i) .gt. 0 ) go to 10 + z = - 3 + return + 10 min = c(i) + 1 + do 30 j=1,n + if ( p(i,j) .gt. 0 .and. w(i,j) .gt. 0 ) go to 20 + z = - 3 + return + 20 if ( w(i,j) .lt. min ) min = w(i,j) + 30 continue + if ( c(i) .lt. min ) z = - 5 + 40 continue + do 60 j=1,n + do 50 i=1,m + if ( w(i,j) .le. c(i) ) go to 60 + 50 continue + z = - 4 + return + 60 continue + return + end + subroutine chmthm ( n, m, p, w, c, jdn, jdm, z ) + +c*********************************************************************72 +c +cc CHMTHM checks the input data for MTHM. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdn),w(jdn),c(jdm),z + + if ( n .le. 1 ) z = - 1 + if ( n .ge. jdn ) z = - 1 + if ( m .le. 0 ) z = - 1 + if ( m .ge. jdm ) z = - 1 + if ( z .lt. 0 ) return + maxw = w(1) + minw = w(1) + isumw = 0 + rr = p(1) + + do j=1,n + + if ( p(j) .le. 0 ) z = - 2 + if ( w(j) .le. 0 ) z = - 2 + if ( z .lt. 0 ) return + if ( w(j) .gt. maxw ) maxw = w(j) + if ( w(j) .lt. minw ) minw = w(j) + isumw = isumw + w(j) + r = rr + rr = float(p(j))/float(w(j)) + if ( rr .gt. r ) then + z = - 6 + return + end if + + end do + + if ( c(1) .le. 0 ) z = - 2 + + do i = 2, m + if ( c(i) .le. 0 ) z = - 2 + if ( c(i) .lt. c(i-1) ) then + z = - 7 + return + end if + end do + + if ( minw .gt. c(1) ) z = - 3 + if ( maxw .gt. c(m) ) z = - 4 + if ( isumw .le. c(m) ) z = - 5 + + return + end + subroutine chmtm(n,m,p,w,c,maxn,maxm,z) + +c*********************************************************************72 +c +cc CHMTM checks the input data for MTM. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(1000),w(1000),c(10),z + + if ( n .le. 1 ) z = - 1 + if ( n .gt. maxn ) z = - 1 + if ( m .le. 0 ) z = - 1 + if ( m .gt. maxm ) z = - 1 + if ( z .lt. 0 ) return + maxw = w(1) + minw = w(1) + isumw = 0 + rr = p(1) + do 10 j=1,n + if ( p(j) .le. 0 ) z = - 2 + if ( w(j) .le. 0 ) z = - 2 + if ( z .lt. 0 ) return + if ( w(j) .gt. maxw ) maxw = w(j) + if ( w(j) .lt. minw ) minw = w(j) + isumw = isumw + w(j) + r = rr + rr = float(p(j))/float(w(j)) + if ( rr .le. r ) go to 10 + z = - 6 + return + 10 continue + if ( c(1) .le. 0 ) z = - 2 + if ( m .eq. 1 ) go to 30 + do 20 i=2,m + if ( c(i) .le. 0 ) z = - 2 + if ( c(i) .ge. c(i-1) ) go to 20 + z = - 7 + return + 20 continue + 30 if ( minw .gt. c(1) ) z = - 3 + if ( maxw .gt. c(m) ) z = - 4 + if ( isumw .le. c(m) ) z = - 5 + return + end + subroutine chmtp(n,w,c,jdim,z) + +c*********************************************************************72 +c +cc CHMTP checks the input data for MTP. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdim),c,z + if ( n .ge. 2 .and. n .le. jdim ) go to 10 + z = - 1 + return + 10 if ( c .gt. 0 ) go to 30 + 20 z = - 2 + return + 30 jwp = w(1) + do 60 j=1,n + if ( w(j) .le. 0 ) go to 20 + if ( w(j) .le. c ) go to 40 + z = - 3 + return + 40 if ( w(j) .le. jwp ) go to 50 + z = - 4 + return + 50 jwp = w(j) + 60 continue + return + end + subroutine chmtsl(n,w,c,z,jdn) + +c*********************************************************************72 +c +cc CHMTSL checks the input data for MTSL. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdn),c,z + + if ( n .ge. 2 .and. n .le. jdn - 1 ) go to 10 + z = - 1 + return + 10 if ( c .gt. 0 ) go to 30 + 20 z = - 2 + return + 30 jsw = 0 + do 40 j=1,n + if ( w(j) .le. 0 ) go to 20 + jsw = jsw + w(j) + if ( w(j) .lt. c ) go to 40 + z = - 3 + return + 40 continue + if ( jsw .gt. c ) return + z = - 4 + return + end + subroutine chmtu2(n,p,w,c,z,jdim) + +c*********************************************************************72 +c +cc CHMTU2 checks the input data for MTU2. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdim),w(jdim),c,z + + if ( n .gt. 1 .and. n .le. jdim - 1 ) go to 10 + z = - 1 + return + 10 if ( c .gt. 0 ) go to 30 + 20 z = - 2 + return + 30 do 40 j=1,n + if ( p(j) .le. 0 ) go to 20 + if ( w(j) .le. 0 ) go to 20 + if ( w(j) .gt. c ) go to 50 + 40 continue + return + 50 z = - 3 + return + end + subroutine cmpb(n,w,b,c,z,x,jdn,jdl,maxbck,xx,m,l) + +c*********************************************************************72 +c +cc CMPB solves a bounded change-making problem through the branch-and-bound algorithm. +c +c presented in +c s. martello, p. toth, "solution of the bounded and unbounded change- +c making problem", tims/orsa joint national meeting, san francisco, +c 1977. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdn),b(jdn),x(jdn),c,z + integer xx(jdn),cwf,profit,cws + integer m(jdl),l(jdl) +c +c step 1. +c + kbck = 0 + cwf = c + w(n+1) = 1 + b(n+1) = c + 1 +c +c lower bound computation. +c + cws = c + jsb = 0 + do j=1,n + if ( b(j)*w(j) .gt. cws )go to 20 + cws = cws - b(j)*w(j) + jsb = jsb + b(j) + end do + 20 js = j + jzp = jsb + cws/w(js) + jcp = cws - (cws/w(js))*w(js) + lb = jzp + ( jcp + w(js+1) - 1)/w(js+1) + lb1 = jzp - 1 + ( jcp + w(js-1) + w(js) - 1 )/w(js) + if ( lb1 .lt. lb ) lb = lb1 + if ( jcp .gt. 0 ) go to 50 + z = jzp + do 30 j=1,js + x(j) = b(j) + 30 continue + do 40 j =js,n + x(j) = 0 + 40 continue + x(js) = cws/w(js) + return + 50 jdom = jdl + if ( jdom .ge. w(1) ) jdom = w(1) - 1 + if ( jdom .lt. w(n) ) go to 80 + n2 = n + 2 + do 70 jj=2,n + j = n2 - jj + k1 = w(j) + k2 = w(j-1) - 1 + if ( k2 .gt. jdom ) k2 = jdom + do 60 k=k1,k2 + m(k) = j + l(k) = 0 + 60 continue + if ( k2 .eq. jdom ) go to 80 + 70 continue + 80 k1 = w(n) - 1 + if ( k1 .gt. jdom ) k1 = jdom + if ( k1 .eq. 0 ) go to 100 + do 90 k=1,k1 + l(k) = z + 90 continue + 100 xx(1) = c/w(1) + if ( b(1) .lt. xx(1) ) xx(1) = b(1) + do 110 j=2,n + xx(j) = 0 + 110 continue + profit = xx(1) + c = c - xx(1)*w(1) + ii = 2 + go to 150 +c +c step (2.a). +c + 120 if ( c .le. jdom ) go to 140 + if ( c .lt. w(n) ) go to 230 + iiold = ii + 130 if ( c .ge. w(ii) ) go to 150 + ii = ii + 1 + go to 130 + 140 if ( l(c) .ge. z - profit ) go to 230 + iiold = ii + ii = m(c) +c +c step 2. +c + 150 jyp = 0 + jct = c + do 160 i =ii,n + jy = jct/w(i) + if ( jy .gt. b(i) ) jy = b(i) + jyp = jyp + jy + jct = jct - jy*w(i) + jw = w(i+1) + if ( jy .lt. b(i) ) jw = w(i) + if ( z .le. profit + jyp + (jct + jw - 1)/jw ) go to 230 + if ( jct .eq. 0 ) go to 200 + if ( jy .lt. b(i) ) go to 170 + 160 continue + go to 230 + 170 profit = profit + ( jyp - jy ) + i1 = i - 1 + + do k=ii,i1 + xx(k) = b(k) + end do + + 190 ii = i +c +c step 3. +c + c = jct + profit = profit + jy + xx(ii) = jy + ii = ii + 1 + go to 120 +c +c step 4. +c + 200 z = profit + jyp + + do j=1,n + x(j) = xx(j) + end do + + do j=ii,i + x(j) = b(j) + end do + + x(i) = jy + if ( z .ne. lb ) go to 230 + c = cwf + return +c +c step 5. +c + 230 kbck = kbck + 1 + if ( kbck .eq. maxbck ) go to 250 + ib = ii - 1 + do 240 j=1,ib + iij = ii - j + if ( xx(iij) .gt. 0 ) go to 260 + 240 continue + 250 c = cwf + if ( z .gt. c ) z = 0 + return + 260 kk = ii - j + if ( c .ge. w(kk) ) go to 270 + if ( c .gt. jdom ) go to 270 + if ( z - profit .gt. l(c) ) l(c) = z - profit + 270 c = c + w(kk) + profit = profit - 1 + xx(kk) = xx(kk) - 1 + if ( z .gt. profit + (c + w(kk+1) - 1)/w(kk+1) ) go to 280 + c = c + xx(kk)*w(kk) + profit = profit - xx(kk) + xx(kk) = 0 + ii = kk + 1 + go to 230 + 280 ii = kk + 1 + iiold = ii + if ( c .gt. jdom ) go to 290 + if ( l(c) .ge. z - profit ) go to 230 + 290 if ( c - w(kk) .ge. w(n) ) go to 150 + ih = kk +c +c step 6. +c + 300 ih = ih + 1 + if ( z .le. profit + (c + w(ih) - 1)/w(ih) ) go to 230 + if ( ih .gt. n ) go to 230 + if ( c - w(ih) .lt. w(n) ) go to 300 + ii = ih + iiold = ii + go to 150 + end + subroutine core(n,p,w,c,jfo,iz1,icw,minw0,jdim,ff,nnf,nf,fn1, + & fn0,pw) + +c*********************************************************************72 +c +cc CORE determines the core problem. +c +c nf(j) = successor of item j in the corresponding set; +c fn1 (ln1) = pointer to the first (last) item in set n1 (fixed to 1); +c fn0 (ln0) = pointer to the first (last) item in set n0 (fixed to 0); +c fnf (lnf) = pointer to the first (last) item in set nf (free items); +c the set of free items is partitioned into 3 sets: +c ng = items with ratio .gt. lambda, +c nl = items with ratio .lt. lambda, +c ne = items with ratio .eq. lambda; +c nf(n+1) (nf(n+2),nf(n+3)) = pointer to the first item in ng (nl,ne); +c lng (lnl,lne) = pointer to the last item in ng (nl,ne); +c modng (modnl,modne) = number of items in ng (nl,ne). +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdim),w(jdim),ff(jdim),nf(jdim) + integer c,s1,s2,fnf,fn0,fn1,se,teta,ss + real pw(jdim),lambda +c +c step 0 (initialize). +c + do j=1,n + pw(j) = float(p(j))/float(w(j)) + end do + if ( jfo .eq. 0 ) go to 20 + if ( n .ge. 200 ) go to 20 + nnf = n + return + 20 teta = 2.0*sqrt(float(n)) + if ( jfo .eq. 0 ) teta = 5 + keta = 20 + if ( jfo .eq. 0 ) keta = 200 + alpha = 0.2 + if ( jfo .eq. 0 ) alpha = 0. + beta = 1. + fn0 = n + 1 + ln0 = n + 1 + fn1 = n + 1 + ln1 = n + 1 + fnf = 1 + lnf = n + do j=1,n + nf(j) = j + 1 + end do + np1 = n + 1 + modnf = n + ln0p = n + 1 + ln1p = n + 1 + ls1 = 0 + klam = 0 +c +c step 1. +c +c choose lambda (median of the ratios of 3 items in nf). + 40 lambda = fmed(nf,jdim,pw,n,fnf,lnf) +c +c step 2. +c +c define ng, nl, ne; +c compute s1 = sum of weights of items in (n1 union ng); +c compute s2 = sum of weights of items in (n1 union ng union ne). +c + 50 klam = klam + 1 + if ( klam .gt. keta ) go to 440 + s1 = ls1 + se = 0 + lng = n + 1 + nf(lng) = np1 + lnl = n + 2 + nf(lnl) = np1 + lne = n + 3 + nf(lne) = np1 + nf(lnf) = np1 + j = fnf + modng = 0 + modne = 0 + 60 if ( pw(j) - lambda ) 70,80,90 + 70 nf(lnl) = j + lnl = j + go to 100 + 80 nf(lne) = j + lne = j + se = se + w(j) + modne = modne + 1 + go to 100 + 90 nf(lng) = j + lng = j + s1 = s1 + w(j) + modng = modng + 1 + 100 j = nf(j) + if ( j .le. n ) go to 60 + s2 = s1 + se + if ( s1 .gt. c ) go to 310 + if ( s2 .le. c ) go to 370 +c +c lambda has been found. +c + if ( modne .ge. teta ) go to 110 + if ( modng + modne .lt. teta ) go to 470 + go to 460 +c +c step 2.1 (add ng to n1 and nl to n0). +c + 110 if ( fn1 .le. n ) go to 120 + fn1 = nf(n+1) + go to 130 + 120 nf(ln1) = nf(n+1) + 130 if ( fn0 .le. n ) go to 140 + fn0 = nf(n+2) + go to 150 + 140 nf(ln0) = nf(n+2) + 150 jfpr = 2 + if ( nf(n+1) .gt. n ) go to 160 + ln1p = ln1 + ln1 = lng + 160 if ( nf(n+2) .gt. n ) go to 170 + ln0p = ln0 + ln0 = lnl + 170 nf(ln1) = np1 + nf(ln0) = np1 + nout = 0 + if ( modne .eq. teta ) go to 260 +c +c step 2.2 (subset-sum type problems). +c + j = nf(n+3) + ss = s1 + ness = 0 + 180 ss = ss + w(j) + if ( ss .gt. c ) go to 190 + ness = ness + 1 + j = nf(j) + go to 180 + 190 if ( ness .le. teta/2 ) go to 260 + if ( modne - ness .le. teta/2 ) go to 200 + nout = ness - teta/2 + go to 210 + 200 nout = modne - teta +c +c insert in set n1 the first nout elements of set ne. +c + 210 j = nf(n+3) + ness = 0 + 220 ness = ness + 1 + if ( ness .eq. nout ) go to 230 + j = nf(j) + go to 220 + 230 if ( fn1 .le. n ) go to 240 + fn1 = nf(n+3) + go to 250 + 240 nf(ln1) = nf(n+3) + 250 ln1 = j + nf(n+3) = nf(j) + nf(ln1) = np1 +c +c define the core problem. +c + 260 k = 0 + nf(lne) = np1 + j = nf(n+3) + 270 k = k + 1 + ff(k) = j + if ( k .eq. teta ) go to 280 + j = nf(j) + go to 270 + 280 if ( modne .eq. nout + teta ) go to 530 +c +c insert in set n0 the last elements of set ne. +c + j = nf(j) + if ( fn0 .le. n ) go to 290 + fn0 = j + go to 300 + 290 nf(ln0) = j + 300 ln0 = lne + go to 530 +c +c step 3 (lambda is too small). +c + 310 if ( float(modng) .lt. float(teta)*(1. - alpha) ) go to 470 +c +c set nf equal to ng. +c + fnf = nf(n+1) + lnf = lng + modnf = modng +c +c add (nl union ne) to n0. +c + ln0p = ln0 + jfpr = 0 + if ( fn0 .le. n ) go to 330 + if ( nf(n+2) .le. n ) go to 320 + fn0 = nf(n+3) + go to 360 + 320 fn0 = nf(n+2) + go to 350 + 330 if ( nf(n+2) .le. n ) go to 340 + nf(ln0) = nf(n+3) + go to 360 + 340 nf(ln0) = nf(n+2) + 350 nf(lnl) = nf(n+3) + 360 ln0 = lne + go to 430 +c +c step 4 (lambda is too large). +c + 370 modnl = modnf - modng - modne + if ( float(modnl) .lt. float(teta)*(1. - alpha) ) go to 460 +c +c set nf equal to nl. +c + fnf = nf(n+2) + lnf = lnl + modnf = modnl +c +c add (ng union ne) to n1. +c + ln1p = ln1 + jfpr = 1 + if ( fn1 .le. n ) go to 390 + if ( nf(n+1) .le. n ) go to 380 + fn1 = nf(n+3) + go to 420 + 380 fn1 = nf(n+1) + go to 410 + 390 if ( nf(n+1) .le. n ) go to 400 + nf(ln1) = nf(n+3) + go to 420 + 400 nf(ln1) = nf(n+1) + 410 nf(lng) = nf(n+3) + 420 ln1 = lne + ls1 = s2 + 430 if ( float(modnf) .gt. (1. + beta)*float(teta) ) go to 40 +c +c step 5 (set the core problem equal to nf). +c + 440 j = fnf + nf(lnf) = np1 + k = 0 + 450 k = k + 1 + ff(k) = j + j = nf(j) + if ( j .le. n ) go to 450 + go to 530 +c +c step 6 (update lambda). +c +c lambda = median of the ratios of 3 items in ng. + 460 jfret = 1 + if ( modng .lt. 3 ) go to 480 + jfret = 0 + lambda = fmed(nf,jdim,pw,n,nf(n+1),lng) + go to 480 +c +c lambda = median of the ratios of 3 items in nl. +c + 470 jfret = 1 + modnl = modnf - modng - modne + if ( modnl .lt. 3 ) go to 480 + jfret = 0 + lambda = fmed(nf,jdim,pw,n,nf(n+2),lnl) +c +c re-define the previous set of free items ( = ne union ng union nl ). +c + 480 fnf = nf(n+3) + if ( nf(n+1) .le. n ) go to 500 + if ( nf(n+2) .le. n ) go to 490 + lnf = lne + go to 520 + 490 nf(lne) = nf(n+2) + lnf = lnl + go to 520 + 500 nf(lne) = nf(n+1) + if ( nf(n+2) .le. n ) go to 510 + lnf = lng + go to 520 + 510 nf(lng) = nf(n+2) + lnf = lnl + 520 if ( jfret .eq. 1 ) go to 440 + go to 50 +c +c step 7. +c + 530 nnf = k +c +c compute iz1 and icw. +c + iz1 = 0 + icw = c + if ( fn1 .gt. n ) go to 550 + j = fn1 + nf(ln1) = np1 + 540 if ( j .gt. n ) go to 550 + iz1 = iz1 + p(j) + icw = icw - w(j) + j = nf(j) + go to 540 +c +c compute minw0. +c + 550 minw0 = 10*c + if ( fn0 .gt. n ) go to 570 + j = fn0 + nf(ln0) = np1 + 560 if ( j .gt. n ) go to 570 + if ( w(j) .lt. minw0 ) minw0 = w(j) + j = nf(j) + go to 560 +c +c add items to the core problem until the maximum weight +c in core is .le. icw . +c + 570 maxwc = 0 + do k=1,nnf + j = ff(k) + if ( w(j) .gt. maxwc ) maxwc = w(j) + end do + 590 if ( maxwc .le. icw ) go to 640 + j = fn1 + pwmin = pw(j) + jmin = j + jminp = 0 + 600 if ( j .gt. n ) go to 620 + if ( pw(j) .ge. pwmin ) go to 610 + pwmin = pw(j) + jmin = j + jminp = jp + 610 jp = j + j = nf(j) + go to 600 + 620 nnf = nnf + 1 + ff(nnf) = jmin + iz1 = iz1 - p(jmin) + icw = icw + w(jmin) + if ( jminp .ne. 0 ) go to 630 + fn1 = nf(jmin) + go to 590 + 630 nf(jminp) = nf(jmin) + go to 590 + 640 return + end + subroutine corec(n,w,i1,i2,i3,jdn,nc,pr) + +c*********************************************************************72 +c +cc COREC determines the core problem. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdn),pr(jdn) + integer iv(3),ivs(3) + nc = n/20 + if ( nc .lt. 500 ) nc = 500 + iv(1) = i1 + pr(1) = 1 + iv(2) = i2 + pr(2) = 2 + iv(3) = i3 + pr(3) = 3 + call sorti(3,iv,pr,3) + ivs(1) = - iv(pr(3)) + ivs(2) = - iv(pr(2)) + ivs(3) = - iv(pr(1)) + jtest = 1 + jvtest = - ivs(1) + lli = 1 + do 30 j=1,nc + 10 if ( lli .lt. jvtest ) go to 20 + if ( lli .eq. jvtest ) ivs(jtest) = - ivs(jtest) + jtest = jtest + 1 + jvtest = n + 1 + if ( jtest .le. 3 ) jvtest = - ivs(jtest) + go to 10 + 20 pr(j) = lli + if ( j .lt. nc ) lli = lli + (n - lli)/(nc - j) + 30 continue + nt = nc + 1 + if ( ivs(1) .gt. 0 ) go to 40 + nt = nt - 1 + if ( ivs(2) .eq. pr(nt) .or. ivs(3) .eq. pr(nt) ) nt = nt - 1 + if ( ivs(2) .eq. pr(nt) .or. ivs(3) .eq. pr(nt) ) nt = nt - 1 + pr(nt) = - ivs(1) + 40 if ( ivs(2) .gt. 0 ) go to 50 + nt = nt - 1 + if ( ivs(1) .eq. pr(nt) .or. ivs(3) .eq. pr(nt) ) nt = nt - 1 + if ( ivs(1) .eq. pr(nt) .or. ivs(3) .eq. pr(nt) ) nt = nt - 1 + pr(nt) = - ivs(2) + 50 if ( ivs(3) .gt. 0 ) return + nt = nt - 1 + if ( ivs(1) .eq. pr(nt) .or. ivs(2) .eq. pr(nt) ) nt = nt - 1 + if ( ivs(1) .eq. pr(nt) .or. ivs(2) .eq. pr(nt) ) nt = nt - 1 + pr(nt) = - ivs(3) + return + end + subroutine cores(n,p,w,c,jfo,iz1,icw,minw0,jdim,ff,nnf,nf,fn1, + & fn0,pw) + +c*********************************************************************72 +c +cc CORES determines the core problem. +c +c Discussion: +c +c It is assumed the items are already sorted +c according to decreasing profit per unit weight. +c +c nf(j) = successor of item j in the corresponding set; +c fn1 = pointer to the first item in set n1 (fixed to 1); +c fn0 = pointer to the first item in set n0 (fixed to 0); +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdim),w(jdim),ff(jdim),nf(jdim) + integer c,fn0,fn1,teta + real pw(jdim) +c +c find the critical item. +c + if ( jfo .eq. 0 ) go to 10 + if ( n .ge. 200 ) go to 10 + nnf = n + return + 10 teta = 2.0*sqrt(float(n)) + if ( jfo .eq. 0 ) teta = 8 + if ( teta .gt. n ) teta = n + ic = c + do 20 j=1,n + if ( w(j) .gt. ic ) go to 30 + ic = ic - w(j) + 20 continue +c +c no exit this way. +c + 30 ll = j - 1 +c +c define the core problem. +c + ll1 = ll - teta/2 + if ( ll1 .lt. 1 ) ll1 = 1 + ll2 = ll1 + teta - 1 + if ( ll2 .le. n ) go to 40 + ll2 = n + ll1 = n - teta + 1 + 40 nnf = teta + iz1 = 0 + icw = c + ll1m1 = ll1 - 1 + if ( ll1m1 .gt. 0 ) go to 50 + fn1 = n + 1 + go to 70 + 50 fn1 = 1 + + do j=1,ll1m1 + iz1 = iz1 + p(j) + icw = icw - w(j) + nf(j) = j + 1 + end do + + nf(ll1m1) = n + 1 + 70 maxwc = 0 + + do j=1,teta + jj = j + ll1m1 + ff(j) = jj + if ( w(jj) .gt. maxwc ) maxwc = w(jj) + end do + + if ( maxwc .le. icw ) go to 110 + j = ll1 + 90 j = j - 1 + iz1 = iz1 - p(j) + icw = icw + w(j) + nnf = nnf + 1 + ff(nnf) = j + if ( maxwc .gt. icw ) go to 90 + if ( j .gt. 1 ) go to 100 + fn1 = n + 1 + go to 110 + 100 nf(j-1) = n + 1 + 110 minw0 = 10*c + ll2p1 = ll2 + 1 + if ( ll2p1 .le. n ) go to 120 + fn0 = n + 1 + go to 140 + 120 fn0 = ll2p1 + do 130 j=ll2p1,n + if ( w(j) .lt. minw0 ) minw0 = w(j) + nf(j) = j + 1 + 130 continue + 140 do 150 j=1,nnf + jj = ff(j) + pw(jj) = float(p(jj))/float(w(jj)) + 150 continue + return + end + subroutine defpck(m,jdimpc) + +c*********************************************************************72 +c +cc DEFPCK defines the vectors for packing. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer y + common /pack/ mask1(30),itwo(30),mask,y(150,100) + do i=1,m + itwo(i) = 2**(i-1) + mask1(i) = 2**(jdimpc) - 1 - itwo(i) + end do + mask = 1 + return + end + subroutine detns1(na,a,n6,ss,il,ir,ii,nxt,v,ns1,nlr) + +c*********************************************************************72 +c +cc DETNS1 computes the cardinality of set A1. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + dimension a(na),ss(n6) + ns1 = 0 + next = nxt + do 90 i=il,ii,7 + if ( a(i+3) .lt. v ) go to 40 + if ( a(i+1) .lt. v ) go to 20 + if ( a(i) .lt. v ) go to 10 + ss(next) = i - 1 + go to 80 + 10 ns1 = ns1 + 1 + ss(next) = i + go to 80 + 20 if ( a(i+2) .lt. v ) go to 30 + ns1 = ns1 + 2 + ss(next) = i + 1 + go to 80 + 30 ns1 = ns1 + 3 + ss(next) = i + 2 + go to 80 + 40 if ( a(i+5) .lt. v ) go to 60 + if ( a(i+4) .lt. v ) go to 50 + ns1 = ns1 + 4 + ss(next) = i + 3 + go to 80 + 50 ns1 = ns1 + 5 + ss(next) = i + 4 + go to 80 + 60 if ( a(i+6) .lt. v ) go to 70 + ns1 = ns1 + 6 + ss(next) = i + 5 + go to 80 + 70 ns1 = ns1 + 7 + ss(next) = i + 6 + 80 next = next + 1 + 90 continue + nlr = 0 + irr = ii + 7 + if ( irr .gt. ir ) return + do i=irr,ir + if ( a(i) .ge. v ) go to 110 + nlr = nlr + 1 + end do + 110 ns1 = ns1 + nlr + return + end + subroutine detns2(na,a,n6,ss,il,ir,ii,nxt,v,ns2,nlr) + +c*********************************************************************72 +c +cc DETNS2 computes the cardinality of set A2. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + dimension a(na),ss(n6) + ns2 = 0 + next = nxt + do 50 i=il,ii,7 + is = ss(next) + 1. + i6 = i + 6 + if ( is .le. i6 ) go to 10 + ss(next) = i6 + go to 40 + 10 do 20 j=is,i6 + if ( a(j) .gt. v ) go to 30 + 20 continue + ns2 = ns2 + i6 - is + 1 + ss(next) = i6 + go to 40 + 30 ns2 = ns2 + j - is + ss(next) = j - 1 + 40 next = next + 1 + 50 continue + irr = ii + 7 + nlr + if ( irr .gt. ir ) return + ner = 0 + do 60 i=irr,ir + if ( a(i) .gt. v ) go to 70 + ner = ner + 1 + 60 continue + 70 ns2 = ns2 + ner + nlr = nlr + ner + return + end + subroutine dinsm(n,w,cd,m2,jdd,td1,td2,td3,nsds,nsdm,m, + & jflm,jfls,pers) + +c*********************************************************************72 +c +cc DINSM determines the dynamic programming lists. +c +c Discussion: +c +c for each state j , td*(j,1) gives the weight, td*(j,2) gives +c the corresponding bit string. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(n),cd + integer td1(jdd,2),td2(jdd,2),td3(jdd,2) + jdds = jdd + jddm = jdd + k = n + td1(1,1) = 0 + td1(1,2) = 0 + td1(2,1) = w(n) + td1(2,2) = 1 + jcall = 1 + nsds = 2 + nsdm = 0 + jbit = 1 + jsumw = w(n) + 10 k = k - 1 + jsumw = jsumw + w(k) + if ( k .lt. n - m2 + 1 ) go to 120 + if ( w(k) .gt. cd ) go to 120 + jbit = jbit*2 + nsdso = nsds + if ( jcall .eq. 2 ) go to 20 + if ( jcall .eq. 3 ) go to 30 + if ( jcall .eq. 4 ) go to 40 + if ( jcall .eq. 5 ) go to 50 + if ( jcall .eq. 6 ) go to 60 + call tab(td1,td2,nsds,w(k),cd,jdds,jdd,jbit,jflag) + jcall = 2 + go to 70 + 20 call tab(td2,td1,nsds,w(k),cd,jdds,jdd,jbit,jflag) + jcall = 1 + go to 70 + 30 call tab(td1,td3,nsds,w(k),cd,jddm,jdd,jbit,jflag) + jcall = 4 + go to 70 + 40 call tab(td3,td1,nsds,w(k),cd,jddm,jdd,jbit,jflag) + jcall = 3 + go to 70 + 50 call tab(td2,td3,nsds,w(k),cd,jddm,jdd,jbit,jflag) + jcall = 6 + go to 70 + 60 call tab(td3,td2,nsds,w(k),cd,jddm,jdd,jbit,jflag) + jcall = 5 + 70 if ( jflag .ge. 0 ) go to 80 + nsds = jdds + go to 90 + 80 if ( nsds .le. jddm ) go to 10 + 90 if ( nsdm .gt. 0 ) go to 10 + nsdm = nsdso +c +c define the new value of cd and update nsds . +c + nm21 = n - m2 + 1 + cd = float(w(nm21))*pers + if ( jcall .eq. 2 ) go to 100 + call usedin(cd,td1,jdd,nsds,loc) + jflm = 2 + jcall = 3 + go to 110 + 100 call usedin(cd,td2,jdd,nsds,loc) + jflm = 1 + jcall = 5 + 110 nsds = loc + m = n - k + go to 10 + 120 if ( jcall .eq. 2 ) go to 130 + if ( jcall .eq. 3 ) go to 140 + if ( jcall .eq. 4 ) go to 150 + if ( jcall .eq. 5 ) go to 160 + if ( jcall .eq. 6 ) go to 170 + jflm = 1 + jfls = 1 + nsdm = nsds + m = n - k + cd = td1(nsds,1) + go to 180 + 130 jflm = 2 + jfls = 2 + nsdm = nsds + m = n - k + cd = td2(nsds,1) + go to 180 + 140 jfls = 1 + cd = td1(nsds,1) + go to 180 + 150 jfls = 3 + cd = td3(nsds,1) + go to 180 + 160 jfls = 2 + cd = td2(nsds,1) + go to 180 + 170 jfls = 3 + cd = td3(nsds,1) + 180 return + end + subroutine dmind(n,m,p,w,mind,jdimr,jdimc,ind,pwv) + +c*********************************************************************72 +c +cc DMIND defines pointers to the sorted items for 0-1 single knapsack problems. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),mind(jdimr,jdimc) + integer ind(jdimc) + real pwv(jdimc) + + do i=1,m + do j=1,n + pwv(j) = float(p(i,j))/float(w(i,j)) + ind(j) = j + end do + call sortr(n,pwv,ind,jdimc) + do j=1,n + mind(i,j) = ind(j) + end do + end do + + return + end + subroutine enumer(n,w,c,xstar,z,lbstar,back, + & x,r,wa,wb,kfix,fixit,xred,ls,lsb,local,xheu, + & res,rel,jdim) + +c*********************************************************************72 +c +cc ENUMER performs a branch-and-bound search. +c +c computation of lower bounds l2 and l3 at all nodes. +c reduction at all nodes (but initial reduction before calling). +c heuristic algorithms at all nodes. +c dominance tests at all nodes. +c +c kfix(k) = 0 if no item was fixed at level k , +c = pointer to the first item fixed at level k , otherwise. +c fixit(j) = 0 if item j is not fixed by reduction, +c = pointer to the next item fixed by reduction at the same +c level, otherwise ( = - 1 for the last item fixed by +c reduction at a level). +c ls(i) = pointer to the last item inserted in bin i if +c lsb(i) = n + 1 , +c = pointer to the last item which can be (and was) inserted +c with item lsb(i) as last but one, if lsb(i) .le. n . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdim),c,xstar(jdim),z,back + integer x(jdim),r(jdim),wa(jdim),wb(jdim),kfix(jdim),fixit(jdim), + & xred(jdim),ls(jdim),lsb(jdim),local(jdim),xheu(jdim), + & res(jdim),rel(jdim) + integer zz +c +c initialization. +c + mback = back + back = 0 + jdirk = 1 +c +c first heuristic. +c + call ffdls(n,w,c,zz,r,x,ls,lsb,jdim) + if ( zz .ge. z ) go to 20 + do i=1,n + xstar(i) = x(i) + end do + z = zz + 20 do i=1,n + fixit(i) = 0 + kfix(i) = 0 + end do + lastw = w(n) +c +c lower bound l1. +c + isumr = 0 + do j=1,zz + isumr = isumr + r(j) + end do + isum = zz*c - isumr + lb1 = (isum - 1)/c + 1 + if ( lb1 .gt. lbstar ) lbstar = lb1 + if ( lbstar .eq. z ) return +c +c improved lower bound. +c + iss = 0 + do i=1,n + if ( w(i) + w(n) .le. c ) go to 60 + iss = iss + w(i) + end do +c +c no exit this way. +c + 60 iss = isum - iss + lb1i = i - 1 + (iss - 1)/c + 1 + if ( lb1i .gt. lbstar ) lbstar = lb1i + if ( lbstar .eq. z ) return +c +c lower bound l2. +c + call l2(n,w,c,lb2,jdim) + if ( lb2 .gt. lbstar ) lbstar = lb2 + if ( lbstar .eq. z ) return + kzffd = zz +c +c second heuristc. +c + mw = 1 + mb = 1 + wa(1) = c + call hbfds(n,w,c,mb,wa,local,wb,jdim) + if ( mb .ge. z ) go to 80 + do i=1,n + xstar(i) = wb(i) + end do + z = mb + if ( z .eq. lbstar ) return +c +c third heuristic. +c + 80 call mwfds(n,w,c,mw,wa,local,lbstar,wb,jdim) + if ( mw .ge. z ) go to 100 + do i=1,n + xstar(i) = wb(i) + end do + z = mw + if ( z .eq. lbstar ) return +c +c iterative part. +c +c backtracking when the optimal solution has been updated. +c find the first item k inserted in bin z . +c + 100 k = n + zz = kzffd - 1 + 110 if ( fixit(k) .ne. 0 ) go to 130 + j = x(k) + r(j) = r(j) + w(k) + if ( kfix(k) .eq. 0 ) go to 120 + call restor(k,zz,n,c,kfix,fixit,w,x,r,lastw,jdim) + 120 if ( r(kzffd) .eq. c ) go to 140 + 130 k = k - 1 + jdirk = - 1 + go to 110 +c +c find the next item k not inserted in bin z - 1 . +c + 140 k = k - 1 + jdirk = - 1 + if ( fixit(k) .ne. 0 ) go to 140 + j = x(k) + if ( j .lt. zz ) go to 150 + r(j) = r(j) + w(k) + if ( kfix(k) .eq. 0 ) go to 140 + call restor(k,zz,n,c,kfix,fixit,w,x,r,lastw,jdim) + go to 140 + 150 if ( r(zz) .eq. c ) zz = zz - 1 +c +c backtracking on item k. +c + 160 if ( k .eq. 1 ) return + if ( fixit(k) .ne. 0 ) go to 180 + if ( back .eq. mback ) return + back = back + 1 + j = x(k) + r(j) = r(j) + w(k) + if ( kfix(k) .eq. 0 ) go to 170 + call restor(k,zz,n,c,kfix,fixit,w,x,r,lastw,jdim) + if ( r(j) .lt. c ) go to 190 + go to 180 + 170 if ( r(zz) .lt. c ) go to 190 + lsb(zz) = n + 1 + zz = zz - 1 + 180 k = k - 1 + jdirk = - 1 + go to 160 +c +c find the first bin following bin j where item k can be inserted. +c + 190 if ( j .lt. z - 1 ) go to 200 + k = k - 1 + jdirk = - 1 + go to 160 + 200 j = j + 1 + if ( r(j) .lt. w(k) ) go to 190 +c +c dominance tests. +c + if ( lsb(j) .gt. n ) go to 250 + if ( j .gt. zz ) go to 250 + lsj = ls(j) + if ( w(k) .gt. w(lsj) ) go to 210 + if ( w(k) + lastw .le. r(j) ) go to 250 + go to 190 + 210 lsj = lsb(j) + if ( w(k) .gt. w(lsj) ) go to 250 + next = ls(j) - 1 + lsj = ls(j) + 220 if ( next .le. k ) go to 190 + if ( fixit(next) .gt. 0 ) go to 230 + if ( w(next) .gt. w(lsj) ) go to 240 + 230 next = next - 1 + go to 220 + 240 if ( w(k) + w(next) .gt. r(j) ) go to 190 + 250 x(k) = j + r(j) = r(j) - w(k) + if ( r(j) .lt. lastw ) go to 260 + ls(j) = k + lsb(j) = n + 1 + go to 270 + 260 lsb(j) = ls(j) + ls(j) = k + 270 if ( j .le. zz ) go to 280 + zz = zz + 1 +c +c forward step. +c + 280 if ( k .eq. n ) go to 420 +c +c computation of a local lower bound. +c on output from lcl2, llb contains the lower bound, while na , +c wa and wb define the problem to be reduced: +c na items with weights in wa . from wa(1) to wa(zz) weights +c correspond to bins partially filled, from wa(zz+1) to wa(na) +c correspond to free items. from wb(1) to wb(zz) pointers to the +c bins, from wb(zz+1) to wb(na) pointers to the items. +c + call lcl2(n,w,c,isum,r,fixit,zz,z,k,na,wa,wb,llb,jdim) + if ( llb .ge. z ) go to 160 +c +c reduction. +c on return from l3 : nbin bins (in total, old + new), xred +c gives the corresponding partial solution, nfree the number of +c remaining free items. if nfree .lt. 0 , l3 tried to match +c pairs of bins. +c + call l3(na,wa,c,zz,nbin,local,xred,nfree,lbr,z,xheu,isum,mr, + & res,rel,jdim) + if ( nfree .lt. 0 ) go to 160 + if ( nfree .eq. 0 ) go to 330 + if ( lbr .ge. z ) go to 160 + if ( mr .ge. z ) go to 320 + z = mr + do 290 i=1,n + xstar(i) = x(i) + 290 continue + jz1 = zz + 1 + do 310 ii=jz1,na + i = wb(ii) + j = xheu(ii) + if ( j .le. zz ) go to 300 + xstar(i) = j + go to 310 + 300 xstar(i) = wb(j) + 310 continue + if ( z .eq. lbstar ) return + if ( lbr .ge. z ) go to 160 + 320 call fixred(w,r,na,wa,wb,zz,x,nbin,xred,k,kfix,fixit,jdim) + lastw = wa(na) + go to 370 + 330 if ( nbin .ge. z ) go to 160 + z = nbin + do 340 i=1,n + xstar(i) = x(i) + 340 continue + jz1 = zz + 1 + do 360 ii=jz1,na + i = wb(ii) + j = xred(ii) + if ( j .le. zz ) go to 350 + xstar(i) = j + go to 360 + 350 xstar(i) = wb(j) + 360 continue + if ( z .eq. lbstar ) return + go to 160 +c +c local heuristics. +c on output from fixred, the na free weights are in wa , the +c corresponding pointers in xred . +c + 370 mb = zz + call hbfds(na,wa,c,mb,r,local,wb,jdim) + if ( mb .ge. z ) go to 380 + call update(n,z,xstar,na,mb,x,wb,xred,jdim) + if ( z .eq. lbstar ) return + if ( llb .ge. z ) go to 160 + 380 mw = zz + call mwfds(na,wa,c,mw,r,local,llb,wb,jdim) + if ( mw .ge. z ) go to 390 + call update(n,z,xstar,na,mw,x,wb,xred,jdim) + if ( z .eq. lbstar ) return + if ( llb .ge. z ) go to 160 + 390 k = k + 1 + if ( jdirk .eq. 1 ) go to 410 + do 400 ii=1,zz + if ( ls(ii) .lt. k ) go to 400 + ls(ii) = lsb(ii) + lsb(ii) = n + 1 + 400 continue + 410 if ( fixit(k) .ne. 0 ) go to 370 + j = 0 + go to 190 + 420 z = zz + do 430 i=1,n + xstar(i) = x(i) + 430 continue + kzffd = z + if ( z .gt. lbstar ) go to 100 + return + end + subroutine feas(n,m,p,w,c,xstar,jfi,jdimr,jdimc) + +c*********************************************************************72 +c +cc FEAS checks for infeasibility. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),c(jdimr),xstar(jdimc) + + jfi = 0 + + do j=1,n + xstar(j) = 0 + kinf = 0 + do 10 i=1,m + if ( w(i,j) .le. c(i) ) go to 10 + kinf = kinf + 1 + p(i,j) = 0 + 10 continue + if ( kinf .eq. m ) jfi = 1 + end do + + return + end + subroutine ffdls(n,w,c,m,k,x,ls,lsb,jdim) + +c*********************************************************************72 +c +cc FFDLS performs a first-fit decreasing heuristic and initializes LS and LSB. +c +c time complexity o(n**2) . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdim),c,k(jdim),x(jdim),ls(jdim),lsb(jdim) + m = 1 + k(1) = c - w(1) + x(1) = 1 + ls(1) = 1 + lsb(1) = n + 1 + do 40 i=2,n +c +c insert the next item. +c + iwi = w(i) + do j=1,m + if ( iwi .le. k(j) ) go to 20 + end do +c +c initialize a new bin. +c + m = m + 1 + k(m) = c - iwi + x(i) = m + ls(m) = i + lsb(m) = n + 1 + go to 40 +c +c insert the item into an old bin. +c + 20 k(j) = k(j) - iwi + x(i) = j + if ( k(j) .lt. w(n) ) go to 30 + ls(j) = i + go to 40 + 30 lsb(j) = ls(j) + ls(j) = i + 40 continue + + return + end + subroutine fixred(w,r,na,wa,wb,zz,x,nbin,xred,k,kfix,fixit, + & jdim) + +c*********************************************************************72 +c +cc FIXRED fixes the variables after a local reduction. +c +c current solution: zz , x . +c current level: k . +c on output, wa contains the weights of the na free items, +c xred the corresponding pointers. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdim),r(jdim),wa(jdim),wb(jdim),x(jdim),xred(jdim), + & kfix(jdim),fixit(jdim) + integer zz +c +c find the first item fixed. +c + iz1 = zz + 1 + ia = 0 + do ii=iz1,na + if ( xred(ii) .gt. 0 ) go to 20 + ia = ia + 1 + wa(ia) = wa(ii) + xred(ia) = wb(ii) + end do + na = ia + return + 20 i = wb(ii) + kfix(k) = i + 30 last = i + j = xred(ii) + if ( j .le. zz ) go to 40 + x(i) = j + r(j) = r(j) - w(i) + go to 50 + 40 x(i) = wb(j) + iwbj = wb(j) + r(iwbj) = r(iwbj) - w(i) + 50 if ( ii .eq. na ) go to 70 + ii = ii + 1 + if ( xred(ii) .gt. 0 ) go to 60 + ia = ia + 1 + wa(ia) = wa(ii) + xred(ia) = wb(ii) + go to 50 + 60 i = wb(ii) + fixit(last) = i + go to 30 + 70 fixit(last) = - 1 + zz = nbin + na = ia + return + end + function fmed(nf,jdim,pw,n,i1,ilast) + +c*********************************************************************72 +c +cc FMED computes median of the ratios of the first 2 and the last item. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer nf(jdim) + real pw(n) + i2 = nf(i1) + i3 = ilast + if ( pw(i1) .le. pw(i2) ) go to 10 + if ( pw(i1) .le. pw(i3) ) go to 20 + fmed = pw(i2) + if ( fmed .lt. pw(i3) ) fmed = pw(i3) + return + 10 if ( pw(i1) .ge. pw(i3) ) go to 20 + fmed = pw(i2) + if ( fmed .gt. pw(i3) ) fmed = pw(i3) + return + 20 fmed = pw(i1) + return + end + subroutine forwd(na,a,n6,ss,lev,l,r,t,nxt,v,jflag) + +c*********************************************************************72 +c +cc FORWRD performs statements 1-9. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + dimension a(na),ss(n6) + integer l(6),r(6),t(6) + il = l(lev) + ir = r(lev) + it = t(lev) + nn = ir - il + 1 + itarg = nn +c +c statement 1 . +c + if ( nn .gt. 97 ) go to 20 + 10 call mpsort(na,a,il,ir,it,v) + jflag = 1 + return +c +c statement 2 . +c + 20 itarg = 59*itarg/70 + ilc = il + imed = (il + ir)/2 + p = a(imed) + if ( a(il) .le. p ) go to 30 + a(imed) = a(il) + a(il) = p + p = a(imed) + 30 irc = ir + if ( a(ir) .ge. p ) go to 50 + a(imed) = a(ir) + a(ir) = p + p = a(imed) + if ( a(il) .le. p ) go to 50 + a(imed) = a(il) + a(il) = p + p = a(imed) + go to 50 + 40 a(irc) = a(ilc) + a(ilc) = aux + 50 irc = irc - 1 + if ( a(irc) .gt. p ) go to 50 + aux = a(irc) + 60 ilc = ilc + 1 + if ( a(ilc) .lt. p ) go to 60 + if ( ilc .le. irc ) go to 40 +c +c statement 3 . +c + if ( it .gt. ilc - il ) go to 70 + ir = ilc - 1 + go to 80 +c +c statement 4 . +c + 70 it = it - ( ilc - il ) + il = ilc + 80 nn = ir - il + 1 + if ( nn .le. 97 ) go to 10 +c +c statement 5 . +c + if ( nn .le. itarg ) go to 20 +c +c statement 6 . +c + jflag = 0 + l(lev) = il + r(lev) = ir + t(lev) = it + lev = lev + 1 + nn7 = nn/7 + ii = il + 7*(nn7 - 1) + next = nxt + l(lev) = nxt + do i=il,ii,7 + call sort7(na,a,i) + ss(next) = a(i+3) + next = next + 1 + end do + i1 = ii + 7 + i2 = ir - 1 + 100 if ( i1 .gt. i2 ) go to 120 + do 110 i=i1,i2 + if ( a(i) .le. a(i+1) ) go to 110 + ap = a(i) + a(i) = a(i+1) + a(i+1) = ap + 110 continue + i2 = i2 - 1 + go to 100 + 120 r(lev) = next - 1 +c +c statement 7 . +c + it1 = it + n1 = (11*nn + 279)/280 + it = it/7 + if ( n1 .gt. it ) it = n1 + n2 = nn7 - n1 + 1 + if ( n2 .lt. it ) it = n2 +c +c statement 8 . +c + if ( it .le. (it1 + 3)/4 ) go to 130 + t(lev) = (it1 + 3)/4 + return +c +c statement 9 . +c + 130 itt = nn7 - (nn - it1 + 4)/4 + 1 + if ( it .lt. itt ) it = itt + t(lev) = it + return + end + subroutine gha(p,w,c,n,m,z,xstar,iub,best,kvst,inf, + & jdimr,jdimc,kw,mw,pen,first,second,bb) + +c*********************************************************************72 +c +cc GHA applies the approximate algorithm gh with function (a). +c +c and +c define the infinite value inf . +c +c if iub = z the solution is optimal; +c if z = kvst no feasible solution was found. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),c(jdimr),xstar(jdimc), + & best(jdimc),z + integer kw(jdimr),mw(jdimr),pen(jdimc),first(jdimc), + & second(jdimc),bb(jdimc) + integer fmax,smax + inf = 0 + do i=1,m + kw(i) = c(i) + mw(i) = 0 + if ( c(i) .gt. inf ) inf = c(i) + end do + iub = 0 + z = 0 + kvst = 0 + do 40 j=1,n + ipmin = p(1,j) + fmax = p(1,j) + if = 1 + smax = 0 + do 30 i=2,m + if ( p(i,j) .lt. ipmin ) ipmin = p(i,j) + if ( smax .ge. p(i,j) ) go to 30 + if ( fmax .ge. p(i,j) ) go to 20 + smax = fmax + is = if + fmax = p(i,j) + if = i + go to 30 + 20 smax = p(i,j) + is = i + 30 continue + kvst = kvst + ipmin + first(j) = if + best(j) = if + second(j) = is + pen(j) = fmax - smax + if ( smax .eq. 0 ) pen(j) = - 1 + bb(j) = j + iub = iub + fmax + if ( w(if,j) .gt. mw(if) ) mw(if) = w(if,j) + if ( w(is,j) .gt. mw(is) ) mw(is) = w(is,j) + 40 continue + if ( kvst .gt. 0 ) kvst = kvst - 1 + if ( iub .gt. inf ) inf = iub + do 50 j=1,n + if ( pen(j) .eq. (- 1) ) pen(j) = inf + 50 continue + nb = n + 60 maxpen = - 1 + do 70 jj=1,nb + j = bb(jj) + if ( pen(j) .le. maxpen ) go to 70 + maxpen = pen(j) + jjm = jj + 70 continue + jo = bb(jjm) + io = first(jo) + z = z + p(io,jo) + xstar(jo) = io + bb(jjm) = bb(nb) + nb = nb - 1 + if ( nb .eq. 0 ) return + kw(io) = kw(io) - w(io,jo) + if ( mw(io) .le. kw(io) ) go to 60 + do 120 jj=1,nb + j = bb(jj) + if ( w(io,j) .le. kw(io) ) go to 120 + if ( first(j) .ne. io ) go to 80 + if ( pen(j) .eq. inf ) go to 130 + first(j) = second(j) + go to 90 + 80 if ( second(j) .ne. io ) go to 120 + 90 index = first(j) + w(index,j) = w(index,j) + inf + newsec = 0 + do 100 i=1,m + if ( w(i,j) .gt. kw(i) ) go to 100 + if ( p(i,j) .le. newsec ) go to 100 + newsec = p(i,j) + is = i + 100 continue + w(index,j) = w(index,j) - inf + if ( newsec .eq. 0 ) go to 110 + second(j) = is + pen(j) = p(index,j) - newsec + if ( w(is,j) .gt. mw(is) ) mw(is) = w(is,j) + go to 120 + 110 pen(j) = inf + 120 continue + go to 60 + 130 z = kvst + return + end + subroutine ghbcd(p,w,c,n,m,z,xstar,inf,jdimr,jdimc,xsp, + & dmyr1,dmyr2,dmyr3,dmyr4,dmyr5, + & dmyc2,dmyc3,dmyc4,dmycr1,dmya) + +c*********************************************************************72 +c +cc GHBCD applies the approximate algorithm GH with functions (b), (c) and (d). +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),c(jdimr),xstar(jdimc),z + integer vsp,xsp(jdimc) + integer dmyr1(jdimr),dmyr2(jdimr),dmyr3(jdimr),dmyr4(jdimr), + & dmyr5(jdimr),dmyc2(jdimc),dmyc3(jdimc),dmyc4(jdimc), + & dmya(jdimr,jdimc) + real dmycr1(jdimc) + + jj = 2 + a1 = 1. + a2 = 0. + a3 = 0. + a4 = 0. + a5 = 1. + 10 call ghx(p,w,c,n,m,vsp,xsp,a1,a2,a3,a4,a5,inf,jdimr,jdimc, + & dmyr1,dmyr2,dmyr3,dmyr4,dmyr5,dmyc2,dmyc3,dmyc4, + & dmycr1,dmya) + if ( vsp .le. z ) go to 30 + z = vsp + do 20 j=1,n + xstar(j) = xsp(j) + 20 continue + 30 if ( jj .eq. 3 ) go to 40 + if ( jj .eq. 4 ) go to 50 + jj = 3 + a1 = 1. + a2 = 0. + a3 = 1. + a4 = 0. + a5 = 0. + go to 10 + 40 jj = 4 + a1 = 0. + a2 = 1. + a3 = 0. + a4 = 1. + a5 = 0. + go to 10 + 50 return + end + subroutine ghx(p,w,c,n,m,z,xstar,a1,a2,a3,a4,a5,inf,jdimr,jdimc, + & kw,mw,minw,kchan,kwr,first,second,bb,pen,wl) + +c*********************************************************************72 +c +cc GHX applies the approximate algorithm gh with function (b) or (c) or (d). +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),xstar(jdimc),c(jdimr),z + integer kw(jdimr),mw(jdimr),minw(jdimr),kchan(jdimr),kwr(jdimr), + & first(jdimc),second(jdimc),bb(jdimc),wl(jdimr,jdimc) + real pen(jdimc),maxpen + + do i=1,m + kw(i) = c(i) + mw(i) = 0 + minw(i) = inf + do j=1,n + wl(i,j) = w(i,j) + if ( wl(i,j) .lt. minw(i) ) minw(i) = wl(i,j) + end do + kwr(i) = kw(i) - minw(i) + end do + + z = 0 + do 60 j=1,n + fmax = - inf + if = 0 + smax = - inf + do 40 i=1,m + if ( wl(i,j) .gt. kw(i) ) go to 40 + if ( wl(i,j) .gt. kwr(i) ) wl(i,j) = kw(i) + rwl = wl(i,j) + rp = p(i,j) + rkw = kw(i) + s = (- a1*rwl + a2*rp)/(a3*rkw + a4*rwl + a5) + if ( smax .ge. s ) go to 40 + if ( fmax .ge. s ) go to 30 + smax = fmax + is = if + fmax = s + if = i + go to 40 + 30 smax = s + is = i + 40 continue + first(j) = if + second(j) = is + pen(j) = fmax - smax + bb(j) = j + if ( wl(if,j) .gt. mw(if) ) mw(if) = wl(if,j) + if ( smax .gt. float(- inf) ) go to 50 + pen(j) = inf + go to 60 + 50 if ( wl(is,j) .gt. mw(is) ) mw(is) = wl(is,j) + 60 continue + nb = n + 70 maxpen = - 1 + do 80 jj=1,nb + j = bb(jj) + if ( pen(j) .le. maxpen ) go to 80 + maxpen = pen(j) + jjm = jj + 80 continue + jo = bb(jjm) + io = first(jo) + z = z + p(io,jo) + xstar(jo) = io + bb(jjm) = bb(nb) + nb = nb - 1 + kw(io) = kw(io) - w(io,jo) + if ( nb .eq. 0 ) go to 210 + kk = 0 + do 110 i=1,m + kchan(i) = 0 + if ( wl(i,jo) .gt. minw(i) ) go to 100 + minw(i) = inf + do 90 jj=1,nb + j = bb(jj) + if ( wl(i,j) .lt. minw(i) ) minw(i) = wl(i,j) + 90 continue + if ( minw(i) + mw(i) .le. kw(i) ) go to 100 + kk = 1 + kchan(i) = 1 + 100 kwr(i) = kw(i) - minw(i) + 110 continue + if ( mw(io) .le. kw(io) ) go to 120 + kk = 1 + kchan(io) = 1 + 120 if ( kk .eq. 0 ) go to 70 + do 190 jj=1,nb + j = bb(jj) + jf = first(j) + if ( pen(j) .lt. float(inf) ) go to 130 + if ( wl(jf,j) .gt. kw(jf) ) go to 200 + go to 190 + 130 if ( kchan(jf) .eq. 0 ) go to 140 + if ( wl(jf,j) .gt. kwr(jf) ) go to 150 + 140 js = second(j) + if ( kchan(js) .eq. 0 ) go to 190 + if ( wl(js,j) .le. kwr(js) ) go to 190 + 150 fmax = - inf + smax = - inf + if = 0 + do 170 i=1,m + if ( wl(i,j) .gt. kw(i) ) go to 170 + if ( wl(i,j) .gt. kwr(i) ) wl(i,j) = kw(i) + rwl = wl(i,j) + rp = p(i,j) + rkw = kw(i) + s = (- a1*rwl + a2*rp)/(a3*rkw + a4*rwl + a5) + if ( smax .ge. s ) go to 170 + if ( fmax .ge. s ) go to 160 + smax = fmax + is = if + fmax = s + if = i + go to 170 + 160 smax = s + is = i + 170 continue + first(j) = if + second(j) = is + pen(j) = fmax - smax + if ( wl(if,j) .gt. mw(if) ) mw(if) = wl(if,j) + if ( smax .gt. float(- inf) ) go to 180 + pen(j) = inf + go to 190 + 180 if ( wl(is,j) .gt. mw(is) ) mw(is) = wl(is,j) + 190 continue + go to 70 + 200 z = 0 + return +c +c try to improve on the current solution z. +c + 210 do 230 j=1,n + if = xstar(j) + maxp = p(if,j) + do 220 i=1,m + if ( w(i,j) .gt. kw(i) ) go to 220 + if ( p(i,j) .le. maxp ) go to 220 + maxp = p(i,j) + if = i + 220 continue + ip = xstar(j) + if ( if .eq. ip ) go to 230 + xstar(j) = if + z = z + p(if,j) - p(ip,j) + kw(ip) = kw(ip) + w(ip,j) + kw(if) = kw(if) - w(if,j) + 230 continue + + return + end + subroutine gr1(p,w,c,n,m,z,xstar,iub,best,b,a,nr,kq,kvst, + & jdimr,jdimc) + +c*********************************************************************72 +c +cc GR1 reduces a maximization gap. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),c(jdimr),xstar(jdimc), + & best(jdimc),b(jdimc),a(jdimr,jdimc),kq(jdimr),z + integer po,bej + + nr = n + do i=1,m + kq(i) = c(i) + end do + + do j=1,n + b(j) = 1 + do i=1,m + a(i,j) = 0 + end do + end do + + if ( z .eq. kvst ) return + m1 = m - 1 + jgap = iub - z + 40 nvr = n*m + nrold = nr + do 90 j=1,n + if ( b(j) .eq. 1 ) go to 50 + nvr = nvr - m + go to 90 + 50 bej = best(j) + po = p(bej,j) + nf = 0 + do 80 i=1,m + if ( w(i,j) .gt. kq(i) ) go to 60 + if ( po - p(i,j) .lt. jgap ) go to 70 + 60 a(i,j) = - 1 + nf = nf + 1 + go to 80 + 70 ib = i + 80 continue + if ( nf .ge. m ) go to 100 + nvr = nvr - nf + if ( nf .lt. m1 ) go to 90 + b(j) = 0 + a(ib,j) = 1 + kq(ib) = kq(ib) - w(ib,j) + nr = nr - 1 + nvr = nvr - 1 + 90 continue + if ( nr .eq. 0 ) return + if ( nr .lt. nrold ) go to 40 + return + 100 nr = 0 + nvr = 0 + return + end + subroutine gr2(n,m,p,w,q,b,a,mind,pak,kap,pakl,ip,ir,il,if,nr, + & z,xstar,jub,x,v,flrep,kvst,jdimr,jdimc,jnlev,in) + +c*********************************************************************72 +c +cc GR2 reduces a maximization gap. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),q(jdimr),b(jdimc), + & a(jdimr,jdimc),mind(jdimr,jdimc),pak(jdimr,jdimc), + & kap(jdimr,jdimc),pakl(jdimr),ip(jdimr),ir(jdimr), + & il(jdimr),if(jdimr),xstar(jdimc),x(jdimr,jdimc), + & v(jnlev,jdimr),flrep(jdimr),z + integer in(jdimr) + do i=1,m + flrep(i) = 0 + end do + + if ( z .eq. kvst ) return + call prepen(n,m,p,w,q,b,a,mind,pak,kap,pakl,ip,ir,il,if, + & jdimr,jdimc) + jgap = jub - z + nvr = 0 + ipnr0 = 0 + do 210 j=1,n + if ( b(j) .eq. 0 ) go to 210 + n1 = 0 + na = 0 + isum = 0 + do 140 i=1,m + if ( a(i,j) .eq. (- 1) ) go to 140 + if ( w(i,j) .gt. q(i) ) go to 120 + if ( x(i,j) .eq. 0 ) go to 90 +c +c compute the loss lam of knapsack i if x(i,j) = 0 . +c + jj = kap(i,j) + kl = il(i) + kp = ip(i) + kr = ir(i) + if ( jj - (kl + 1) ) 40,20,130 + 20 if ( kl + 1 .eq. pakl(i) ) go to 30 + jkl = pak(i,kl+2) + rub = float(kp) + float(p(i,jkl)*kr)/float(w(i,jkl)) + go to 80 + 30 rub = kp + go to 80 + 40 kp = kp - p(i,j) + kr = kr + w(i,j) + la = kl + 1 + l2 = pakl(i) + if ( la .le. l2 ) go to 50 + rub = kp + go to 80 + 50 do 60 jl=la,l2 + jj = pak(i,jl) + if ( w(i,jj) .gt. kr ) go to 70 + kr = kr - w(i,jj) + kp = kp + p(i,jj) + 60 continue + rub = kp + go to 80 + 70 rub = float(kp) + float(p(i,jj)*kr)/float(w(i,jj)) + 80 iub = rub + lam = v( 1,i) - (iub + if(i)) + if ( lam .ge. jgap ) go to 150 + if ( lam .le. 0 ) go to 130 + isum = isum + lam + n1 = n1 + 1 + in(n1) = i + if ( isum .ge. jgap ) go to 170 + go to 130 +c +c compute the loss lam of knapsack i if x(i,j) = 1 . +c + 90 jj = kap(i,j) + kl = il(i) + if ( jj .le. kl ) go to 130 + kr = ir(i) - w(i,j) + kp = ip(i) + p(i,j) + 100 if ( kr .ge. 0 ) go to 110 + jkl = pak(i,kl) + kr = kr + w(i,jkl) + kp = kp - p(i,jkl) + kl = kl - 1 + go to 100 + 110 jkl = pak(i,kl+1) + rub = float(kp) + float(p(i,jkl)*kr)/float(w(i,jkl)) + iub = rub + lam = v(1,i) - (iub + if(i)) + if ( lam .lt. jgap ) go to 130 + a(i,j) = - 1 + flrep(i) = 1 + go to 140 + 120 a(i,j) = - 1 + flrep(i) = 1 + go to 140 + 130 na = na + 1 + ib = i + 140 continue + if ( na .eq. 0 ) go to 310 + if ( na .gt. 1 ) go to 200 + i = ib + 150 b(j) = 0 + do ii=1,m + a(ii,j) = - 1 + flrep(ii) = 1 + end do + a(i,j) = 1 + nr = nr - 1 + q(i) = q(i) - w(i,j) + ipnr0 = ipnr0 + p(i,j) + go to 210 + + 170 do i=1,m + if ( a(i,j) .ne. (- 1) ) then + a(i,j) = - 1 + flrep(i) = flrep(i) + 1 + end if + end do + + do ii=1,n1 + i = in(ii) + a(i,j) = 0 + flrep(i) = flrep(i) - 1 + end do + + na = n1 + 200 nvr = nvr + na + 210 continue + do i=1,m + if ( flrep(i) .gt. 1 ) flrep(i) = 1 + end do + if ( nr .gt. 1 ) return + if ( nr .eq. 0 ) go to 260 + max = - 1 + do j=1,n + if ( b(j) .eq. 1 ) go to 240 + end do + + 240 b(j) = 0 + nr = 0 + do 250 i=1,m + if ( a(i,j) .eq. (- 1) ) go to 250 + if ( w(i,j) .gt. q(i) ) go to 250 + if ( p(i,j) .le. max ) go to 250 + max = p(i,j) + ii = i + 250 continue + if ( max .lt. 0 ) return + a(ii,j) = 1 + q(ii) = q(ii) - w(ii,j) + ipnr0 = ipnr0 + p(ii,j) + 260 do i=1,m + ipnr0 = ipnr0 + if(i) + end do + + if ( ipnr0 .le. z ) return + z = ipnr0 + do 300 j=1,n + do i=1,m + if ( a(i,j) .eq. 1 ) go to 290 + end do + 290 xstar(j) = i + 300 continue + return + 310 nr = 0 + return + end + subroutine hbfds(n,w,c,m,kk,k,x,jdim) + +c*********************************************************************72 +c +cc HBFDS performs a best-fit decreasing heuristic. +c +c for local use with current solution given. +c time complexity o(n**2) . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdim),c,k(jdim),x(jdim),kk(jdim) + do j=1,m + k(j) = kk(j) + end do + + do 40 i=1,n +c +c insert the next item. +c + iwi = w(i) + minres = c + do 20 j=1,m + kres = k(j) - iwi + if ( kres .lt. 0 ) go to 20 + if ( kres .ge. minres ) go to 20 + minres = kres + jm = j + 20 continue + if ( minres . lt. c ) go to 30 +c +c initialize a new bin. +c + m = m + 1 + k(m) = c - iwi + x(i) = m + go to 40 +c +c insert the item into an old bin. +c + 30 k(jm) = k(jm) - iwi + x(i) = jm + 40 continue + + return + end + subroutine heur(p,w,c,n,m,z,xstar,iub,jub,best,kvst,inf, + & jdimr,jdimc,dmyr1,dmyr2,dmyr3,dmyr4,dmyr5, + & dmyc1,dmyc2,dmyc3,dmyc4,dmycr1,a) + +c*********************************************************************72 +c +cc HEUR determines the best initial heuristic solution. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),c(jdimr),z,xstar(jdimc), + & best(jdimc) + integer dmyr1(jdimr),dmyr2(jdimr),dmyr3(jdimr),dmyr4(jdimr), + & dmyr5(jdimr) + integer dmyc1(jdimc),dmyc2(jdimc),dmyc3(jdimc),dmyc4(jdimc) + real dmycr1(jdimc) + integer a(jdimr,jdimc) +c +c first heuristic solution. +c + call gha(p,w,c,n,m,z,xstar,iub,best,kvst,inf, + & jdimr,jdimc,dmyr1,dmyr2,dmyc1,dmyc2,dmyc3,dmyc4) + jub = iub + if ( z .eq. jub ) return +c +c second heuristic solution. +c + call ghbcd(p,w,c,n,m,z,xstar,inf, + & jdimr,jdimc,dmyc1,dmyr1,dmyr2,dmyr3,dmyr4,dmyr5, + & dmyc2,dmyc3,dmyc4,dmycr1,a) + return + end + subroutine impr1(n,p,w,m,z,x,cr,inf,jdn,jdm,f) + +c*********************************************************************72 +c +cc IMPR1: first improvement. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdn),w(jdn),x(jdn),cr(jdm),z + integer f(jdm,jdm),cp,wp,ff,u,t,q,r,s,d + mp1 = m + 1 + cr(mp1) = 0 + maxf = 0 + cp = 0 + + do i=1,m + ip1 = i + 1 + do 10 j=ip1,mp1 + f(i,j) = cr(i) + cr(j) + f(j,i) = f(i,j) + if ( f(i,j) .le. maxf ) go to 10 + maxf = f(i,j) + ip = i + jp = j + 10 continue + f(i,i) = 0 + if ( cp .lt. cr(i) ) cp = cr(i) + end do + + f(mp1,mp1) = 0 + do 30 j=1,n + if ( x(j) .lt. mp1 ) go to 30 + ff = j + go to 40 + 30 continue + return + 40 wp = w(ff) + if ( ff .eq. n ) go to 60 + if1 = ff + 1 + do 50 j=if1,n + if ( x(j) .lt. mp1 ) go to 50 + if ( w(j) .lt. wp ) wp = w(j) + 50 continue + 60 if ( f(ip,jp) .lt. wp ) return + j = 1 + 70 ixj = x(j) + if ( cr(ixj) + cp .lt. wp ) go to 230 + k = j + 1 + 80 if ( k .gt. n ) go to 230 + ixj = x(j) + ixk = x(k) + if ( f(ixj,ixk) .lt. wp ) go to 120 + if ( w(j) - w(k) ) 90,120,100 + 90 u = k + t = j + go to 110 + 100 u = j + t = k + 110 d = w(u) - w(t) + i = x(u) + ixt = x(t) + if ( d .gt. cr(ixt) )go to 120 + if ( cr(i) + d .ge. wp ) go to 130 + 120 k = k + 1 + go to 80 + 130 icipd = cr(i) + d + maxp = 0 + do 140 q=ff,n + if ( x(q) .lt. mp1 ) go to 140 + if ( w(q) .gt. icipd ) go to 140 + if ( p(q) .le. maxp ) go to 140 + r = q + maxp = p(r) + 140 continue + cr(i) = cr(i) + d - w(r) + cr(ixt) = cr(ixt) - d + z = z + p(r) + do 150 q=1,m + f(i,q) = cr(i) + cr(q) + f(q,i) = f(i,q) + f(ixt,q) = cr(ixt) + cr(q) + f(q,ixt) = f(ixt,q) + 150 continue + f(i,i) = 0 + f(ixt,ixt) = 0 + if ( i .eq. ip ) go to 160 + if ( i .eq. jp ) go to 160 + if ( ixt .eq. ip ) go to 160 + if ( ixt .ne. jp ) go to 190 + 160 maxf = 0 + do 180 q=1,m + ip1 = q + 1 + do 170 s=ip1,mp1 + if ( f(q,s) .le. maxf ) go to 170 + maxf = f(q,s) + ip = q + jp = s + 170 continue + 180 continue + 190 x(r) = i + x(u) = ixt + x(t) = i + if ( w(r) .ne. wp ) go to 210 + wp = inf + do 200 s=ff,n + if ( x(s) .lt. mp1 ) go to 200 + if ( w(s) .lt. wp ) wp = w(s) + 200 continue + 210 if ( f(ip,jp) .lt. wp ) return + cp = 0 + do 220 s=1,m + if ( cp .lt. cr(s) ) cp = cr(s) + 220 continue + ixj = x(j) + if ( cr(ixj) + cp .lt. wp ) go to 230 + k = k + 1 + go to 80 + 230 if ( j .eq. n ) return + j = j + 1 + go to 70 + end + subroutine impr2(n,p,w,m,z,x,cr,min,xx,inf,jdn,jdm) + +c*********************************************************************72 +c +cc IMPR2: second improvement. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdn),w(jdn),x(jdn),min(jdn),xx(jdn),cr(jdm),z + integer f,t,v,cb,u,s + mp1 = m + 1 + mink = inf + min(n) = mink + + do i=2,n + kk = n + 2 - i + if ( w(kk) .lt. mink ) mink = w(kk) + min(kk-1) = mink + end do + + do 20 j=1,n + if ( x(j) .le. m ) go to 20 + f = j + go to 30 + 20 continue + return + 30 s = n + j = n + 40 if ( x(j) .eq. mp1 ) go to 140 + ixj = x(j) + cb = cr(ixj) + w(j) + if ( cb*p(f)/w(f) .le. p(j) ) go to 140 + if ( cb .ge. w(f) ) go to 50 + if ( cb .lt. min(f) ) go to 140 + 50 k = f + t = 0 + v = 0 + 60 if ( w(k) .gt. cb ) go to 70 + v = v + p(k) + cb = cb - w(k) + t = t + 1 + xx(t) = k + if ( cb .lt. min(k) ) go to 100 + 70 if ( k .eq. n ) go to 100 + k1 = k + 1 + do 80 u=k1,n + if ( x(u) .le. m ) go to 80 + k = u + go to 90 + 80 continue + go to 100 + 90 if ( v + cb*p(k)/w(k) .gt. p(j) ) go to 60 + 100 if ( v .le. p(j) ) go to 140 + s = j + ixj = x(j) + cr(ixj) = cb + do 110 k=1,t + ixxk = xx(k) + x(ixxk) = x(j) + 110 continue + x(j) = mp1 + z = z + v - p(j) + if ( j .gt. f ) go to 120 + f = j + go to 140 + 120 if ( x(f) .eq. mp1 ) go to 140 + if1 = f + 1 + do 130 u=if1,n + if ( x(u) .le. m ) go to 130 + f = u + go to 140 + 130 continue + 140 j = j - 1 + if ( j .eq. 0 ) j = n + if ( j .eq. s ) return + go to 40 + end + subroutine insert(i,m,fs,x,ifp,k,jdim) + +c*********************************************************************72 +c +cc INSERT inserts item i in bin m and updates fs, x, ifp, k. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer x(jdim),k(jdim),fs + is = x(i) + ip = k(i) + if ( is .gt. 0 ) go to 10 + ifp = ip + go to 20 + 10 k(is) = ip + 20 if ( ip .gt. 0 ) go to 30 + fs = is + go to 40 + 30 x(ip) = is + 40 x(i) = m + return + end + subroutine knapsack_reorder ( n, p, w ) + +c*********************************************************************72 +c +cc KNAPSACK_REORDER reorders knapsack data by "profit density". +c +c Discussion: +c +c This routine must be called to rearrange the data before calling +c routines that handle a knapsack problem. +c +c The "profit density" for object I is defined as P(I)/W(I). +c +c Licensing: +c +c This code is distributed under the GNU LGPL license. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c John Burkardt +c +c Reference: +c +c Donald Kreher, Douglas Simpson, +c Combinatorial Algorithms, +c CRC Press, 1998, +c ISBN: 0-8493-3988-X, +c LC: QA164.K73. +c +c Parameters: +c +c Input, integer N, the number of objects. +c +c Input/output, integer P(N), the "profit" or value of each object. +c +c Input/output, integer W(N), the "weight" or cost of each object. +c + implicit none + + integer n + + integer i + integer j + integer p(n) + integer t + integer w(n) +c +c Rearrange the objects in order of "profit density". +c + do i = 1, n + do j = i+1, n + if ( p(i) * w(j) < p(j) * w(i) ) then + t = p(i) + p(i) = p(j) + p(j) = t + t = w(i) + w(i) = w(j) + w(j) = t + end if + end do + end do + + return + end + subroutine kp01m(n,p,w,c,minw0,z,x,jfo,iubf0,np1, + & xx,ps,ws,zs,minw) + +c*********************************************************************72 +c +cc KP01M solves, through branch-and-bound, a 0-1 single knapsack problem. +c +c Discussion: +c +c it is assumed that the items are sorted according to decreasing +c profit per unit weight. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(np1),w(np1),x(n),c,z + integer xx(n),ps(n),ws(n),zs(n) + real minw(n) + integer cwf,cws,diff,val,r,t,ub,ub1 +c +c initialize. +c + cwf = c + ip = 0 + cws = c + + do ll=1,n + if ( w(ll) .gt. cws ) go to 20 + ip = ip + p(ll) + cws = cws - w(ll) + end do + + 20 ll = ll - 1 + ub = 0 + if ( cws .eq. 0 ) go to 80 + p(np1) = 0 + w(np1) = c + 1 + ntest = 2*n + if ( iubf0 .lt. 0 ) go to 30 + knp1 = (c + 1)/w(n) + 1 + p(np1) = p(n)*knp1 + w(np1) = w(n)*knp1 + ntest = n +c +c ntest is used to avoid integer overflows when iubf0 = 0 . +c + 30 if ( ll + 2 .gt. ntest ) go to 40 + ub = ip + cws*p(ll+2)/w(ll+2) + go to 50 + 40 ub = ip + cws*p(n)/w(n) + 50 a = w(ll+1) - cws + ub1 = float(ip + p(ll+1)) - a*float(p(ll))/float(w(ll)) + if ( ub1 .gt. ub ) ub = ub1 + if ( iubf0 .eq. 0 ) iubf0 = ub + if ( jfo .eq. 0 .and. n .gt. 10 ) go to 80 + mink = c + 1 + minw(n) = mink + do 60 j=2,n + kk = n + 2 - j + if ( w(kk) .lt. mink ) mink = w(kk) + minw(kk-1) = mink + 60 continue + do 70 j=1,n + xx(j) = 0 + 70 continue + val = 0 + lold = n + ii = 1 + if ( iubf0 .lt. 0 ) go to 220 + iubf0 = 0 + fw1 = w(1) + fp1 = p(1) + fpn1 = float(minw0)*float(p(n))/float(w(n)) + a = w(ll+1) - cws + ib = float(ip + p(ll+1)) - a*fp1/fw1 + if ( ib .gt. iubf0 ) iubf0 = ib + go to 220 + 80 z = ip + nn = ll + 1 + do 90 j=nn,n + x(j) = - x(j) + 90 continue + go to 580 +c +c try to insert the ii-th item into the current solution. +c + 100 if ( w(ii) .le. c ) go to 120 + if ( iubf0 .lt. 0 ) go to 110 + a = w(ii) - c + ib = float(val + p(ii)) - a*fp1/fw1 + if ( ib .gt. iubf0 ) iubf0 = ib + 110 ii1 = ii + 1 + if ( z .ge. c*p(ii1)/w(ii1) + val ) go to 360 + ii = ii1 + go to 100 +c +c build a new current solution. +c + 120 ip = ps(ii) + cws = c - ws(ii) + in = zs(ii) + do 130 ll=in,n + if ( w(ll) .gt. cws ) go to 200 + ip = ip + p(ll) + cws = cws - w(ll) + 130 continue + ll = n + if ( iubf0 .lt. 0 ) go to 140 + call newb(cws,ip+val,minw0,p(n),w(n),fp1,fpn1,fw1,iubf0) + call newb(cws+w(n),ip+val-p(n),minw0,p(n),w(n),fp1,fpn1, + & fw1,iubf0) + 140 if ( z .ge. ip + val ) go to 360 + z = ip + val + nn = ii - 1 + do 160 j=1,nn + if ( xx(j) .eq. 0 ) go to 150 + x(j) = iabs(x(j)) + go to 160 + 150 x(j) = - iabs(x(j)) + 160 continue + do 170 j=ii,ll + x(j) = iabs(x(j)) + 170 continue + if ( ll .eq. n ) go to 190 + nn = ll + 1 + do 180 j=nn,n + x(j) = - iabs(x(j)) + 180 continue + 190 if ( z .ne. ub ) go to 360 + c = cwf + go to 580 + 200 ll = ll - 1 + if ( iubf0 .lt. 0 ) go to 210 + a = w(ll+1) - cws + ib = float(val + ip + p(ll+1)) - a*fp1/fw1 + if ( ib .gt. iubf0 ) iubf0 = ib + 210 if ( cws .eq. 0 ) go to 140 + if ( z .ge. val + ip + cws*p(ll+1)/w(ll+1) ) go to 360 +c +c save the current solution. +c + 220 ws(ii) = c - cws + ps(ii) = ip + zs(ii) = ll + 1 + xx(ii) = 1 + nn = ll - 1 + if ( nn .lt. ii ) go to 240 + do 230 j=ii,nn + jp1 = j + 1 + ws(jp1) = ws(j) - w(j) + ps(jp1) = ps(j) - p(j) + zs(jp1) = ll + 1 + xx(jp1) = 1 + 230 continue + 240 j1 = ll + 1 + do 250 j=j1,lold + ws(j) = 0 + ps(j) = 0 + zs(j) = j + 250 continue + lold = ll + c = cws + val = val + ip + if ( ll - (n - 2) ) 300, 270, 260 + 260 ii = n + if ( iubf0 .ge. 0 ) go to 290 + go to 320 + 270 if ( c .lt. w(n) ) go to 280 + c = c - w(n) + val = val + p(n) + xx(n) = 1 + if ( iubf0 .lt. 0 ) go to 280 + ii = n - 1 + call newb(c+w(n),val-p(n),minw0,p(n),w(n),fp1,fpn1,fw1, + & iubf0) + go to 290 + 280 ii = n - 1 + if ( iubf0 .lt. 0 ) go to 320 + a = w(n) - c + ib = float(val + p(n)) - a*fp1/fw1 + if ( ib .gt. iubf0 ) iubf0 = ib + 290 call newb(c,val,minw0,p(n),w(n),fp1,fpn1,fw1,iubf0) + go to 320 + 300 ii = ll + 2 + if ( c .ge. int(minw(ii-1)) ) go to 100 + if ( iubf0 .lt. 0 ) go to 320 +c +c compute the bound corresponding to the insertion of items +c ii,...,n. +c + do 310 j=ii,n + if ( z .ge. val + c*p(j)/w(j) ) go to 320 + a = w(j) - c + ib = float(val + p(j)) - a*fp1/fw1 + if ( ib .gt. iubf0 ) iubf0 = ib + 310 continue + call newb(c,val,minw0,p(n),w(n),fp1,fpn1,fw1,iubf0) +c +c save the current optimal solution. +c + 320 if ( z .ge. val ) go to 350 + z = val + do 340 j=1,n + if ( xx(j) .eq. 0 ) go to 330 + x(j) = iabs(x(j)) + go to 340 + 330 x(j) = - iabs(x(j)) + 340 continue + if ( z .ne. ub ) go to 350 + c = cwf + go to 580 + 350 if ( xx(n) .eq. 0 ) go to 360 + xx(n) = 0 + c = c + w(n) + val = val - p(n) +c +c backtrack. +c + 360 nn = ii - 1 + if ( nn .eq. 0 ) go to 380 + do 370 j=1,nn + kk = ii - j + if ( xx(kk) .eq. 1 ) go to 390 + 370 continue + 380 c = cwf + go to 580 + 390 r = c + c = c + w(kk) + val = val - p(kk) + xx(kk) = 0 + if ( r .lt. int(minw(kk)) ) go to 400 + ii = kk + 1 + go to 100 + 400 nn = kk + 1 + ii = kk +c +c try to substitute the nn-th item for the kk-th. +c + 410 if ( nn .gt. n ) go to 360 + if ( z .ge. val + c*p(nn)/w(nn) ) go to 360 + if ( iubf0 .lt. 0 ) go to 420 + if ( nn .eq. n ) call newb(c,val,minw0,p(n),w(n),fp1,fpn1, + & fw1,iubf0) + 420 diff = w(nn) - w(kk) + if ( diff ) 530, 430, 440 + 430 nn = nn + 1 + go to 410 + 440 if ( diff .le. r ) go to 450 + if ( iubf0 .lt. 0 ) go to 430 + a = w(nn) - c + ib = float(val + p(nn)) - a*fp1/fw1 + if ( ib .gt. iubf0 ) iubf0 = ib + go to 430 + 450 if ( iubf0 .lt. 0 ) go to 480 +c +c compute the bound corresponding to the insertion of items +c nn+1,...,n. +c + npro = val + p(nn) + ncw = c - w(nn) + if ( nn .eq. n ) go to 470 + nn1 = nn + 1 + do 460 j=nn1,n + a = w(j) - ncw + ib = float(npro + p(j)) - a*fp1/fw1 + if ( ib .gt. iubf0 ) iubf0 = ib + 460 continue + 470 call newb(ncw,npro,minw0,p(n),w(n),fp1,fpn1,fw1,iubf0) + 480 if ( z .ge. val + p(nn) ) go to 430 + z = val + p(nn) + do 500 j=1,kk + if ( xx(j) .eq. 0 ) go to 490 + x(j) = iabs(x(j)) + go to 500 + 490 x(j) = - iabs(x(j)) + 500 continue + jj = kk + 1 + do 510 j=jj,n + x(j) = - iabs(x(j)) + 510 continue + x(nn) = iabs(x(nn)) + if ( z .ne. ub ) go to 520 + c = cwf + go to 580 + 520 r = r - diff + kk = nn + nn = nn + 1 + go to 410 + 530 t = r - diff + if ( t .ge. int(minw(nn)) ) go to 560 + if ( iubf0 .lt. 0 ) go to 430 +c +c compute the bound corresponding to the insertion of items +c nn+1,...,n. +c + npro = val + p(nn) + ncw = c - w(nn) + if ( nn .eq. n ) go to 550 + nn1 = nn + 1 + do 540 j=nn1,n + if ( z .ge. npro + ncw*p(j)/w(j) ) go to 430 + a = w(j) - ncw + ib = float(npro + p(j)) - a*fp1/fw1 + if ( ib .gt. iubf0 ) iubf0 = ib + 540 continue + 550 call newb(ncw,npro,minw0,p(n),w(n),fp1,fpn1,fw1,iubf0) + go to 430 + 560 if ( z .ge. val + p(nn) + t*p(nn+1)/w(nn+1) ) go to 360 + c = c - w(nn) + val = val + p(nn) + xx(nn) = 1 + ii = nn + 1 + ws(nn) = w(nn) + ps(nn) = p(nn) + zs(nn) = ii + n1 = nn + 1 + do 570 j=n1,lold + ws(j) = 0 + ps(j) = 0 + zs(j) = j + 570 continue + lold = nn + go to 100 + 580 if ( iubf0 .lt. 0 ) iubf0 = ub + if ( iubf0 .lt. z ) iubf0 = z + return + end + subroutine kpmax(ng,pg,wg,cg,zg,xg,mubf, + & jdimc1,jdimc,xxg,min,psign,wsign,zsign) + +c*********************************************************************72 +c +cc KPMAX solves a 0-1 single knapsack problem using an initial solution. +c +c Discussion: +c +c ZG is an initial value of the solution. +c +c This is a modified version of MT1. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer pg(jdimc1),wg(jdimc1),xg(jdimc),cg,zg + integer xxg(jdimc),min(jdimc),psign(jdimc),wsign(jdimc), + & zsign(jdimc) + integer cgs,cgf,diff,profit,r,t +c +c initialize. +c + cgf = cg + ip = 0 + cgs = cg + do ll=1,ng + if ( wg(ll) .gt. cgs ) go to 20 + ip = ip + pg(ll) + cgs = cgs - wg(ll) + end do + 20 ll = ll - 1 + if ( cgs .eq. 0 ) go to 50 + pg(ng+1) = 0 + wg(ng+1) = cg + 1 + lim = ip + cgs*pg(ll+2)/wg(ll+2) + a = wg(ll+1) - cgs + lim1 = float(ip) - a*float(pg(ll))/float(wg(ll)) + + & float(pg(ll+1)) + if ( lim1 .gt. lim ) lim = lim1 + if ( lim .le. zg ) return + lem = ip + cgs*pg(ll+1)/wg(ll+1) + if ( lem .le. mubf ) go to 400 + mink = cg + 1 + min(ng) = mink + do 30 j=2,ng + kk = ng + 2 - j + if ( wg(kk) .lt. mink ) mink = wg(kk) + min(kk-1) = mink + 30 continue + do 40 j=1,ng + xxg(j) = 0 + 40 continue + profit = 0 + lold = ng + ii = 1 + go to 170 + 50 if ( zg .ge. ip ) return + zg = ip + do j=1,ll + xg(j) = 1 + end do + nn = ll + 1 + do j=nn,ng + xg(j) = 0 + end do + return +c +c try to insert the ii-th item into the current solution. +c + 80 if ( wg(ii) .le. cg ) go to 90 + ii1 = ii+1 + if ( zg .ge. cg*pg(ii1)/wg(ii1) + profit ) go to 280 + ii = ii1 + go to 80 +c +c build a new current solution. +c + 90 ip = psign(ii) + cgs = cg - wsign(ii) + in = zsign(ii) + do 100 ll=in,ng + if ( wg(ll) .gt. cgs ) go to 160 + ip = ip + pg(ll) + cgs = cgs - wg(ll) + 100 continue + ll = ng + 110 if ( zg .ge. ip + profit ) go to 280 + zg = ip + profit + nn = ii - 1 + do 120 j=1,nn + xg(j) = xxg(j) + 120 continue + do 130 j=ii,ll + xg(j) = 1 + 130 continue + if ( ll .eq. ng ) go to 150 + nn = ll + 1 + do 140 j=nn,ng + xg(j) = 0 + 140 continue + 150 if ( zg .ne. lim ) go to 280 + cg = cgf + return + 160 ll = ll - 1 + if ( cgs .eq. 0 ) go to 110 + if ( zg .ge. profit + ip + cgs*pg(ll+1)/wg(ll+1) ) go to 280 +c +c save the current solution. +c + 170 wsign(ii) = cg - cgs + psign(ii) = ip + zsign(ii) = ll + 1 + xxg(ii) = 1 + nn = ll - 1 + if ( nn .lt. ii) go to 190 + do 180 j=ii,nn + wsign(j+1) = wsign(j) - wg(j) + psign(j+1) = psign(j) - pg(j) + zsign(j+1) = ll + 1 + xxg(j+1) = 1 + 180 continue + 190 j1 = ll + 1 + do j=j1,lold + wsign(j) = 0 + psign(j) = 0 + zsign(j) = j + end do + lold = ll + cg = cgs + profit = profit + ip + if ( ll - (ng - 2) ) 240, 220, 210 + 210 ii = ng + go to 250 + 220 if ( cg .lt. wg(ng) ) go to 230 + cg = cg - wg(ng) + profit = profit + pg(ng) + xxg(ng) = 1 + 230 ii = ng - 1 + go to 250 + 240 ii = ll + 2 + if ( cg .ge. min(ii-1) ) go to 80 +c +c save the current optimal solution. +c + 250 if ( zg .ge. profit ) go to 270 + zg = profit + do j=1,ng + xg(j) = xxg(j) + end do + if ( zg .ne. lim ) go to 270 + cg = cgf + return + 270 if ( xxg(ng) .eq. 0 ) go to 280 + xxg(ng) = 0 + cg = cg + wg(ng) + profit = profit - pg(ng) +c +c backtrack. +c + 280 nn = ii - 1 + if ( nn .eq. 0 ) return + do 290 jj=1,nn + index = ii - jj + if ( xxg(index) .eq. 1 ) go to 300 + 290 continue + return + 300 kk = ii - jj + r = cg + cg = cg + wg(kk) + profit = profit - pg(kk) + xxg(kk) = 0 + if ( r .lt. min(kk) ) go to 310 + ii = kk + 1 + go to 80 + 310 nn = kk + 1 + ii = kk +c +c try to substitute the nn-th item for the kk-th. +c + 320 if ( zg .ge. profit + cg*pg(nn)/wg(nn) ) go to 280 + diff = wg(nn) - wg(kk) + if ( diff ) 380, 330, 340 + 330 nn = nn + 1 + go to 320 + 340 if ( diff .gt. r ) go to 330 + if ( zg .ge. profit + pg(nn) ) go to 330 + zg = profit + pg(nn) + do 350 j=1,kk + xg(j) = xxg(j) + 350 continue + jj = kk + 1 + do 360 j=jj,ng + xg(j) = 0 + 360 continue + xg(nn) = 1 + if ( zg .ne. lim ) go to 370 + cg = cgf + return + 370 r = r - diff + kk = nn + nn = nn + 1 + go to 320 + 380 t = r - diff + if ( t .lt. min(nn) ) go to 330 + if ( zg .ge. profit + pg(nn) + t*pg(nn+1)/wg(nn+1) ) go to 280 + cg = cg - wg(nn) + profit = profit + pg(nn) + xxg(nn) = 1 + ii = nn + 1 + wsign(nn) = wg(nn) + psign(nn) = pg(nn) + zsign(nn) = ii + n1 = nn + 1 + do 390 j=n1,lold + wsign(j) = 0 + psign(j) = 0 + zsign(j) = j + 390 continue + lold = nn + go to 80 + 400 zg = mubf + do 410 j=1,ng + xg(j) = 0 + 410 continue + return + end + subroutine kpmin(kk,pen,u,d,zp,iy,kubf, + & jdimc,jdimc1,p,w,ind,ix,pw, + & dmyc1,dmyc2,dmyc3,dmyc4,dmyc5) + +c*********************************************************************72 +c +cc KPMIN solves a 0-1 single knapsack problem in minimization form. +c +c It uses a subroutine, kpmax, for the corresponding maximization form. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer pen(jdimc),u(jdimc),iy(jdimc),d,zp + integer p(jdimc1),w(jdimc1),ind(jdimc),ix(jdimc),ds,su,spen + real pw(jdimc) + integer dmyc1(jdimc),dmyc2(jdimc),dmyc3(jdimc),dmyc4(jdimc), + & dmyc5(jdimc) + + su = 0 + spen = 0 + + do k=1,kk + su = su + u(k) + pw(k) = float(pen(k))/float(u(k)) + ix(k) = k + spen = spen + pen(k) + end do + + ds = su - d + i = 0 + iu = 0 + ip = 0 + + call sortr(kk,pw,ix,jdimc) + + do jk=1,kk + + k = ix(jk) + iy(k) = 1 + + if ( u(k) .le. ds ) then + i = i + 1 + p(i) = pen(k) + w(i) = u(k) + ip = ip + p(i) + iu = iu + w(i) + ind(i) = k + end if + + end do + + if ( iu .le. ds ) go to 60 + izm = 0 + + if ( i .eq. 0 ) then + zp = spen - izm + return + end if + + izm = - 1 + call kpmax(i,p,w,ds,izm,ix,spen-kubf, + & jdimc+1,jdimc,dmyc1,dmyc2,dmyc3,dmyc4,dmyc5) + 30 do j=1,i + k = ind(j) + iy(k) = 1 - ix(j) + end do + zp = spen - izm + return + + 60 do j=1,i + ix(j) = 1 + end do + izm = ip + go to 30 + + end + subroutine ksmall(n,s,k,n6,ss) + +c*********************************************************************72 +c +cc KSMALL finds the k-th smallest of n elements in o(n) time. +c +c entrance to ksmall is achieved by using the statement +c call ksmall(n,s,k,(n+5)/6,ss) +c +c the values of the first three parameters must be defined +c by the user prior to calling ksmall. ksmall needs one +c array ( s ) of length n and one array ( ss ) of +c length (n+5)/6 .these arrays must be dimensioned by the +c user in the calling program. +c +c ksmall calls eight subroutines: bld, bldf, blds1, detns1, +c detns2, forwd, mpsort and sort7. +c these subroutines are completely local, i.e. the informa- +c tion they need is passed through the parameter list. +c the whole program is completely self contained and commu- +c nication with it is achieved solely through the parameter +c list of ksmall. no machine dependent costants are used. +c the program is written in american national standard +c fortran and is accepted by the pfort verifier. +c the program has been tested on a cdc cyber 76 , on a cdc +c cyber 730 and on a digital vax 11/780 . +c +c meaning of the input parameters: +c n = number of elements. +c s = array containing the elements. +c k = integer value indicating that the k-th smallest +c element of s must be found ( 1 .le. k .le. n ) . +c +c n , k and n6 are integer, s and ss are real. +c on return, the elements of s are rearranged so that +c s(k) contains the k-th smallest element of s , while +c s(i) .le. s(k) if i .lt. k , s(i) .ge. s(k) if +c i .gt. k . +c the current dimensions of work arrays l , r and t +c allow use of the code for practically any value of n +c ( n .lt. 98*7**5 ). +c +c in the following, the comment sections refer to procedure +c ksmall described in "a hybrid algorithm for finding +c the k-th smallest of n elements in o(n) time" , by +c m. fischetti and s. martello, annals of operational +c research 13, 1988. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + dimension s(n),ss(n6) + integer l(6),r(6),t(6) + l(1) = 1 + r(1) = n + t(1) = k + lev = 1 +c +c statements 1 - 10 . +c + 10 if ( lev .gt. 1 ) go to 20 + call forwd(n,s,n6,ss,lev,l,r,t,1,v,jflag) + go to 30 + 20 call forwd(n6,ss,n6,ss,lev,l,r,t,r(lev)+1,v,jflag) + 30 if ( jflag .eq. 0 ) go to 20 + 40 lev = lev - 1 + if ( lev .eq. 0 ) return + il = l(lev) + ir = r(lev) + it = t(lev) + nn = ir - il + 1 + nn7 = nn/7 + ii = il + 7*(nn7 - 1) + nxt = 1 + if ( lev .gt. 1 ) nxt = ir + 1 +c +c statements 11 - 13 . +c +c compute ns1 = cardinality of set a1 . +c + if ( lev .gt. 1 ) go to 50 + call detns1(n,s,n6,ss,il,ir,ii,nxt,v,ns1,nlr) + go to 60 + 50 call detns1(n6,ss,n6,ss,il,ir,ii,nxt,v,ns1,nlr) + 60 if ( ns1 .lt. it ) go to 90 +c +c explicitly determine set a1 . +c + if ( lev .gt. 1 ) go to 70 + call bldf(n,s,n6,ss,il,ir,nlr) + go to 80 + 70 call blds1(n6,ss,il,ii,nxt,nlr) + 80 r(lev) = il + ns1 - 1 + go to 10 + 90 if ( ns1 .lt. 11*nn/70 ) go to 110 +c +c explicitly determine set a - a1 . +c + t(lev) = it - ns1 + if ( lev .gt. 1 ) go to 100 + call bldf(n,s,n6,ss,il,ir,nlr) + l(lev) = il + ns1 + go to 10 + 100 call bld(n6,ss,il,ir,ii,nxt,nlr) + r(lev) = il + ( nn - ns1 ) - 1 + go to 10 +c +c statements 14 - 16 . +c +c compute ns2 = cardinality of set a2 . +c + 110 if ( lev .gt. 1 ) go to 120 + call detns2(n,s,n6,ss,il,ir,ii,nxt,v,ns2,nlr) + go to 130 + 120 call detns2(n6,ss,n6,ss,il,ir,ii,nxt,v,ns2,nlr) + 130 ns12 = ns1 + ns2 + if ( ns12 .lt. it ) go to 160 + if ( lev .gt. 1 ) go to 40 + call bldf(n,s,n6,ss,il,ir,nlr) + do 140 i=1,ns12 + if ( s(i) .eq. v ) go to 150 + 140 continue + 150 s(i) = s(k) + s(k) = v + return +c +c explicitly determine set a - a1 - a2 . +c + 160 t(lev) = it - ns12 + if ( lev .gt. 1 ) go to 170 + call bldf(n,s,n6,ss,il,ir,nlr) + l(lev) = il + ns12 + go to 10 + 170 call bld(n6,ss,il,ir,ii,nxt,nlr) + r(lev) = il + ( nn - ns12 ) - 1 + go to 10 + end + subroutine l2(n,w,c,lb,jdim) + +c*********************************************************************72 +c +cc L2 computes the lower bound. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdim),c + if ( w(1) .gt. c/2 ) go to 40 +c +c case 1: all items are .le. c/2 . +c + lb = 0 + irat = c/w(1) + ii = 2 + 10 do 20 i=ii,n + ir = c/w(i) + if ( ir .gt. irat ) go to 30 + 20 continue + nlb = (n - 1)/irat + 1 + if ( lb .lt. nlb ) lb = nlb + return + 30 nlb = (i - 2)/irat + 1 + if ( lb .lt. nlb ) lb = nlb + if ( (n - 1)/ir + 1 .le. lb ) return + ii = i + irat = ir + go to 10 +c +c case 2: there exist items .gt. c/2 . +c + 40 call search(n,w,float(c)/2.,n12,jdim) +c +c n12 = n1 + n2 . +c + lb = n12 + if ( n12 .eq. n ) return + n12p1 = n12 + 1 + nmn12 = n - n12 + jbw = c - w(n12) +c +c i2 = next item to be considered for possible inclusion in n2 . +c i3 = next item to be considered for possible inclusion in n3 . +c + i2 = n12 + i3 = n12p1 + 50 jww = w(i3) + 60 i3 = i3 + 1 + if ( i3 .gt. n ) go to 70 + if ( w(i3) .ge. jww ) go to 60 + 70 jwst = w(i3-1) + jbwst = c - jwst + n3 = i3 - n12p1 + 80 if ( w(i2) .gt. jbwst ) go to 100 + if ( i2 .eq. 1 ) go to 90 + i2 = i2 - 1 + go to 80 + 90 n2 = n12 + go to 110 + 100 n2 = n12 - i2 + 110 nn = n2*(jbw/jwst) + jadd = 0 + if ( n3 .gt. nn ) jadd = (n3 - nn - 1)/(c/jwst) + 1 + nlb = n12 + jadd + if ( lb .lt. nlb ) lb = nlb + nadd = (nmn12 - nn - 1)/(c/jwst) + 1 + if ( n12 + nadd .le. lb ) return + if ( i3 .gt. n ) return + go to 50 + end + subroutine l3(n,w,c,zz,mred,k,x,nfreer,lb,ub,xheu,isum,nub, + & res,rel,jdim) + +c*********************************************************************72 +c +cc L3 reduces the current problem, and compute lower bound l3 and a new upper bound nub . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c on output: +c nfreer = number of unassigned variables; +c mred = number of bins used in the reduction without relaxation; +c x(i) = bin in which item i has been inserted by the reduction +c procedure without relaxation, +c = 0 if item i has not been assigned +c (during execution, x(i) is used as a pointer to the +c next free item following i or as the bin in which +c item i has been inserted with relaxation); +c xheu(i) = bin in which item i has been inserted in the heuristic +c solution corresponding to nub +c (during execution, xheu(i) contains the level of +c relaxation at which item i has been assigned; +c if xheu(i) .gt. n , item i has been relaxed); +c res(l) = residual capacity of bin l (l=1,...,m); +c nrel = number of relaxed items; +c rel(irel) = irel-th relaxed item (irel=1,...,nrel); +c krel = level of relaxation; +c mrel = maximum level of relaxations for which the reduction is +c valid; +c kinf = n + 1 if no pair of bins has been matched, +c = level at which the first pair of bins has been matched, +c otherwise. +c +c the items from 1 to zz represent bins partially filled, +c those from zz + 1 to n are real items. +c the subroutine terminates and returns nfree = - 1 if it +c attempts to match pairs of bins. +c + integer w(jdim),c,k(jdim),x(jdim),xheu(jdim),zz,ub + integer res(jdim),rel(jdim),fs,tp,ww,qp,www +c +c initialization. +c + lb = 0 + isumr = isum + mp = 0 + kinf = n + 1 + + do i=1,zz + res(i) = 0 + end do + 20 do 30 i=1,n + x(i) = i + 1 + k(i) = i - 1 + xheu(i) = 0 + 30 continue + krel = 0 + mrel = - 1 + mred = zz + nfreer = n + nrel = 0 + x(n) = 0 + fs = 1 + m = zz + nfree = n + i = 0 + ifp = n + if ( n .le. 2 ) go to 470 + 40 i = fs + jj = ifp +c +c try to assign w(i) . +c + 50 jwb = c - w(i) + ii = x(i) +c +c first test. +c + if ( w(ifp) .le. jwb ) go to 90 +c +c insert only item i . +c + mm = i + if ( i .le. zz ) go to 60 + m = m + 1 + mm = m + 60 is = x(i) + ip = k(i) + k(is) = ip + if ( ip .gt. 0 ) go to 70 + fs = is + go to 80 + 70 x(ip) = is + 80 x(i) = mm + xheu(i) = krel + mp = mp + 1 + res(mm) = c - w(i) + isumr = isumr - w(i) + nfree = nfree - 1 + go to 450 +c +c find the largest free w(jj) which fits into a bin together +c with w(i) ( jj .gt. i ) . +c + 90 j = jj + 100 if ( j .eq. i ) go to 110 + if ( w(j) .gt. jwb ) go to 120 + j = k(j) + go to 100 + 110 if ( i .eq. fs ) go to 120 + ij = k(i) + if ( w(ij) .gt. jwb ) go to 120 + jj = x(j) + go to 460 +c +c second test. +c + 120 jj = x(j) + if ( w(jj) .eq. jwb ) go to 360 +c +c fourth test. +c + isp = k(ifp) + if ( w(ifp) + w(isp) .gt. jwb ) go to 360 + if ( i .eq. isp ) go to 360 +c +c fifth test. +c + llp = ifp + tp = k(isp) + if ( tp .eq. i ) go to 130 + if ( w(ifp) + w(tp) .le. jwb ) go to 240 +c +c only pair (isp,ifp) can be inserted with item i . +c + if ( w(jj) .ge. w(ifp) + w(isp) ) go to 360 + if ( w(jj) .ne. w(isp) ) go to 460 +c +c insert items i , jj and llp . +c + 130 if ( jj .gt. zz ) go to 140 + if ( krel .lt. kinf ) kinf = krel + 140 mm = i + if ( i .le. zz ) go to 150 + m = m + 1 + mm = m + 150 is = x(i) + ip = k(i) + k(is) = ip + if ( ip .gt. 0 ) go to 160 + fs = is + go to 170 + 160 x(ip) = is + 170 x(i) = mm + xheu(i) = krel + mp = mp + 1 + iw = w(i) + w(jj) + w(llp) + res(mm) = c - iw + isumr = isumr - iw + if ( jj .eq. ii ) ii = x(ii) + if ( ii .eq. 0 ) ii = ifp + js = x(jj) + jp = k(jj) + if ( jp .gt. 0 ) go to 180 + fs = js + go to 190 + 180 x(jp) = js + 190 k(js) = jp + x(jj) = mm + xheu(jj) = krel + jj = js + if ( llp .eq. ii ) ii = x(ii) + if ( ii .eq. 0 ) ii = ifp + ls = x(llp) + lp = k(llp) + if ( lp .gt. 0 ) go to 200 + fs = ls + go to 210 + 200 x(lp) = ls + 210 if ( ls .gt. 0 ) go to 220 + ifp = lp + go to 230 + 220 k(ls) = lp + 230 x(llp) = mm + xheu(llp) = krel + if ( jj .eq. llp ) jj = ls + if ( ls .eq. 0 ) jj = ifp + nfree = nfree - 3 + go to 450 +c +c sixth test. +c + 240 www = 0 + if ( w(ifp) + w(isp) + w(tp) .gt. jwb ) go to 280 + qp = k(tp) + if ( qp .eq. i ) go to 250 + if ( w(ifp) + w(isp) + w(qp) .le. jwb ) go to 550 +c +c only triplet (tp,isp,ifp) can be inserted with item i . +c + if ( w(jj) .eq. w(tp) ) go to 250 + www = w(ifp) + w(isp) + w(tp) + go to 280 +c +c insert items i , tp , isp , ifp . +c + 250 if ( tp .gt. zz ) go to 260 + if ( krel .lt. kinf ) kinf = krel + 260 mm = i + if ( i .le. zz ) go to 270 + m = m + 1 + mm = m + 270 call insert(i,mm,fs,x,ifp,k,jdim) + call insert(tp,mm,fs,x,ifp,k,jdim) + call insert(isp,mm,fs,x,ifp,k,jdim) + lifp = ifp + call insert(lifp,mm,fs,x,ifp,k,jdim) + xheu(i) = krel + xheu(tp) = krel + xheu(isp) = krel + xheu(lifp) = krel + mp = mp + 1 + iw = w(i) + w(tp) + w(isp) + w(lifp) + res(mm) = c - iw + isumr = isumr - iw + if ( jj .eq. ii) ii = ifp + jj = ifp + nfree = nfree - 4 + go to 450 +c +c find the best pair (kkp,llp) of total weight ww which can be +c inserted into a bin together with item i . +c + 280 kk = k(jj) + ll = ifp + ww = 0 + 290 ll1 = k(ll) + if ( kk. ge. ll1 ) go to 340 + j = kk + jwl = jwb - w(ll) + 300 j = x(j) + if ( j .ge. ll ) go to 340 + if ( w(j) .gt. jwl ) go to 300 + kk = j + j = ll + jwk = jwb - w(kk) + 310 j = k(j) + if ( j .le. kk ) go to 320 + if ( w(j) .le. jwk ) go to 310 + 320 ll = x(j) + if ( w(kk) + w(ll) .le. ww ) go to 330 + ww = w(kk) + w(ll) + kkp = kk + llp = ll + if ( w(jj) .ge. ww ) go to 330 + if ( w(jj) .ne. w(kkp) ) go to 460 + 330 ll = k(ll) + go to 290 + 340 if ( (w(jj) .ge. ww) .and. (w(jj) .ge. www) ) go to 360 + if ( w(jj) .ne. w(kkp) ) go to 460 +c +c item jj is in the best pair (jj=kkp). +c check whether pair (kkp,llp) dominates all the feasible pairs. +c + jll = k(llp) + jjll = k(jll) + if ( jjll .le. jj ) go to 350 + if ( w(jll) + w(jjll) .le. jwb ) go to 460 + 350 if ( www .eq. 0 ) go to 130 +c +c check whether pair (kkp,llp) dominates triplet (tp,isp,ifp) . +c + if ( w(llp) .lt. w(isp) ) go to 460 + if ( w(kkp) + w(llp) .ge. www ) go to 130 + go to 460 +c +c insert items i and jj . +c + 360 if ( jj .gt. zz ) go to 370 + if ( krel .lt. kinf ) kinf = krel + 370 mm = i + if ( i .le. zz ) go to 380 + m = m + 1 + mm = m + 380 is = x(i) + ip = k(i) + k(is) = ip + if ( ip .gt. 0 ) go to 390 + fs = is + go to 400 + 390 x(ip) = is + 400 x(i) = mm + xheu(i) = krel + mp = mp + 1 + iw = w(i) + w(jj) + res(mm) = c - iw + isumr = isumr - iw + if ( jj .eq. ii ) ii = x(ii) + if ( ii .eq. 0 ) ii = ifp + js = x(jj) + jp = k(jj) + if ( jp .gt. 0 ) go to 410 + fs = js + go to 420 + 410 x(jp) = js + 420 if ( js .gt. 0 ) go to 430 + ifp = jp + go to 440 + 430 k(js) = jp + 440 x(jj) = mm + xheu(jj) = krel + jj = js + if ( js .eq. 0 ) jj = ifp + nfree = nfree - 2 +c +c stopping test. +c + 450 if ( nfree .le. 2 ) go to 470 + 460 i = ii + if ( i .lt. ifp ) go to 50 + go to 670 +c +c optimal solution. +c + 470 if ( nfree .eq. 0 ) go to 670 + i1 = 0 + i = fs + 480 ii = x(i) + if ( i1 .gt. 0 ) go to 500 + i1 = i + mm = i + if ( i .le. zz ) go to 490 + m = m + 1 + mm = m + 490 x(i1) = mm + xheu(i1) = krel + mp = mp + 1 + res(mm) = c - w(i1) + isumr = isumr - w(i1) + if ( nfree .eq. 1 ) go to 540 + go to 530 + 500 if ( w(i) .gt. c - w(i1) ) go to 510 + if ( i .le. zz ) go to 510 + x(i) = mm + xheu(i) = krel + res(mm) = res(mm) - w(i) + isumr = isumr - w(i) + go to 540 + 510 mm = i + if ( i .le. zz ) go to 520 + m = m + 1 + mm = m + 520 x(i) = mm + xheu(i) = krel + mp = mp + 1 + res(mm) = c - w(i) + isumr = isumr - w(i) + go to 540 + 530 i = ii + go to 480 + 540 nfree = 0 + fs = 0 + go to 670 +c +c only second test for the remaining items. +c + 550 if ( krel .gt. 0 ) go to 670 + j = k(ifp) + jb2 = (c + 1)/2 + 560 i = ii + if ( i .eq. ifp ) go to 670 + if ( w(i) .lt. jb2 ) go to 670 + ii = x(i) + jwb = c - w(i) + 570 if ( j .eq. i ) go to 670 + if ( w(j) .gt. jwb ) go to 560 + if ( w(j) .eq. jwb ) go to 580 + j = k(j) + go to 570 +c +c insert items i and j . +c + 580 if ( j .gt. zz ) go to 590 + if ( krel .lt. kinf ) kinf = krel + 590 mm = i + if ( i .le. zz ) go to 600 + m = m + 1 + mm = m + 600 is = x(i) + ip = k(i) + k(is) = ip + if ( ip .gt. 0 ) go to 610 + fs = is + go to 620 + 610 x(ip) = is + 620 x(i) = mm + xheu(i) = krel + mp = mp + 1 + iw = w(i) + w(j) + res(mm) = c - iw + isumr = isumr - iw + if ( j .eq. ii ) ii = x(ii) + if ( ii .eq. 0 ) ii = ifp + js = x(j) + jp = k(j) + if ( jp .gt. 0 ) go to 630 + fs = js + go to 640 + 630 x(jp) = js + 640 if ( js .gt. 0 ) go to 650 + ifp = jp + go to 660 + 650 k(js) = jp + 660 x(j) = mm + xheu(j) = krel + j = jp + nfree = nfree - 2 + if ( nfree .le. 2 ) go to 470 + go to 560 + 670 if ( nfree .eq. 0 ) go to 680 + if ( w(fs) + w(ifp) .gt. c ) go to 40 +c +c check whether all the previously relaxed items can be inserted +c into the bins currently used by the reduced items. +c + 680 if ( kinf .le. n ) go to 710 + if ( nrel .eq. 0 ) go to 700 + ix = rel(nrel) +c +c check whether the last relaxed item ix can be inserted into +c a feasible bin. +c + iw = w(ix) + min = c + 1 + do 690 l=1,m + if ( iw .gt. res(l) ) go to 690 + if ( res(l) .ge. min ) go to 690 + min = res(l) + lmin = l + 690 continue +c +c if min .gt. c then item ix cannot be inserted in any current bin. +c + if ( min .gt. c ) go to 710 +c +c insert item ix in bin lmin and consider the next relaxed item. +c + x(ix) = lmin + xheu(ix) = krel + res(lmin) = res(lmin) - iw + nrel = nrel - 1 + go to 680 +c +c all the relaxed items have been inserted in the current bins. +c + 700 mrel = krel + mred = m + nfreer = nfree +c +c compute the current lower bound lbc . +c + 710 lbc = mp + ( isumr + c - 1 )/c + if ( krel .eq. 0 .and. kinf .le. n ) go to 780 + if ( lb .lt. lbc ) lb = lbc + if ( lb .ge. ub ) return + if ( nfree .eq. 0 ) go to 720 +c +c relax the last item ifp . +c + krel = krel + 1 + xheu(ifp) = n + 1 + isumr = isumr - w(ifp) + nrel = nrel + 1 + rel(nrel) = ifp + ifp = k(ifp) + x(ifp) = 0 + nfree = nfree - 1 + go to 40 +c +c define lb , x(i) , xheu(i) and nub . +c + 720 if ( lb .lt. mp ) lb = mp + nub = m + do 770 i=1,n + if ( xheu(i) .gt. mrel ) go to 730 + xheu(i) = x(i) + go to 770 +c +c item i has not been reduced in a valid way. +c + 730 if ( xheu(i) .gt. n ) go to 740 + xheu(i) = x(i) + x(i) = 0 + go to 770 +c +c try to insert the relaxed item i into an existing bin +c or initialize a new bin. +c + 740 iw = w(i) + min = c + 1 + do 750 l=1,nub + if ( iw .gt. res(l) ) go to 750 + if ( min .le. res(l) ) go to 750 + min = res(l) + lmin = l + 750 continue + if ( min .gt. c ) go to 760 + xheu(i) = lmin + x(i) = 0 + res(lmin) = res(lmin) - w(i) + go to 770 + 760 nub = nub + 1 + xheu(i) = nub + x(i) = 0 + res(nub) = c - w(i) + 770 continue + return + 780 nfreer = - 1 + return + end + subroutine lcl2(n,w,c,isum,r,fixit,zz,z,k,na,wa,wb,llb,jdim) + +c*********************************************************************72 +c +cc LCL2 computes a local lower bound and execute a preprocessing for reduction. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdim),r(jdim),wa(jdim),wb(jdim),fixit(jdim),c,zz,z + + i = n + 10 if ( fixit(i) .eq. 0 ) go to 20 + i = i - 1 + go to 10 + 20 jwn = w(i) + iss = isum + kcb = 0 + + do 30 j=1,zz + wb(j) = j + if ( r(j) .ge. jwn ) go to 30 + iss = iss - (c - r(j)) + kcb = kcb + 1 + 30 continue + + llb = kcb + (iss - 1)/c + 1 + if ( llb .ge. z ) return + + call sorti2(zz,r,wb,jdim) + + do i=1,zz + iwbi = wb(i) + wa(i) = c - r(iwbi) + end do + + k1 = k + 1 + na = zz + do 50 i=k1,n + if ( fixit(i) .ne. 0 ) go to 50 + na = na + 1 + wa(na) = w(i) + wb(na) = i + 50 continue + call l2(na,wa,c,lba,jdim) + if ( lba .gt. llb ) llb = lba + return + end + subroutine maxt(n,w,i1,i2,i3,jdn) + +c*********************************************************************72 +c +cc MAXT determines the three items of maximum weight. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdn) + + max1 = -1 + max2 = -1 + max3 = -1 + i1 = 0 + i2 = 0 + + do 30 i=1,n + if ( w(i) .le. max3 ) go to 30 + if ( w(i) .gt. max1 ) go to 20 + if ( w(i) .gt. max2 ) go to 10 + max3 = w(i) + i3 = i + go to 30 + 10 max3 = max2 + max2 = w(i) + i3 = i2 + i2 = i + go to 30 + 20 max3 = max2 + max2 = max1 + max1 = w(i) + i3 = i2 + i2 = i1 + i1 = i + 30 continue + + return + end + subroutine mgr1(n,p,w,m,c,z,x,cr,inf,jdn,jdm) + +c*********************************************************************72 +c +cc MGR1 finds an initial solution (quick algorithm). +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdn),w(jdn),c(jdm),x(jdn),cr(jdm),z + + do i=1,m + cr(i) = c(i) + end do + + mp1 = m + 1 + p(n+1) = 0 + w(n+1) = inf + j = 1 + i = 1 + z = 0 + 20 if ( w(j) .gt. cr(i) ) go to 30 + x(j) = i + cr(i) = cr(i) - w(j) + z = z + p(j) + j = j + 1 + go to 20 + 30 js = j + x(j) = mp1 + j = j + 1 + do 40 jj=j,n + x(jj) = mp1 + if ( w(jj) .gt. cr(i) ) go to 40 + x(jj) = i + cr(i) = cr(i) - w(jj) + z = z + p(jj) + 40 continue + 50 if ( i .lt. m ) go to 60 + go to 110 + 60 i = i + 1 + do 70 j=js,n + if ( x(j) .le. m ) go to 70 + if ( w(j) .gt. cr(i) ) go to 80 + x(j) = i + cr(i) = cr(i) - w(j) + z = z + p(j) + 70 continue + go to 110 + 80 js = j + j = j + 1 + 90 if ( cr(i)*p(j)/w(j) .eq. 0 ) go to 50 + if ( x(j) .le. m ) go to 100 + if ( w(j) .gt. cr(i) ) go to 100 + x(j) = i + cr(i) = cr(i) - w(j) + z = z + p(j) + 100 j = j + 1 + go to 90 + 110 continue + return + end + subroutine mgr2(n,p,w,m,c,z,x,cr,inf,jdn,jdm) + +c*********************************************************************72 +c +cc MGR2 finds an initial solution (accurate algorithm). +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdn),w(jdn),c(jdm),x(jdn),cr(jdm),z + integer s,d,zcap,vzcap,czcap,vcap,zstar,vzstar,czstar,q + integer a(5,200),v(5),zz(5),cz(5),vz(5),oz(5),b(5),ifb(5), + & minw(201) + z = 0 + jstar = 1 + p(n+1) = 0 + w(n+1) = inf + mp1 = m + 1 + mink = inf + minw(n+1) = mink + + do j=1,n + x(j) = mp1 + kk = n + 1 - j + if ( w(kk) .lt. mink ) mink = w(kk) + minw(kk) = mink + do i=1,m + a(i,j) = 0 + end do + end do + + x(n+1) = mp1 + + do i=1,m + zz(i) = 1 + cz(i) = c(i) + vz(i) = 0 + oz(i) = 0 + b(i) = i + end do + + ibound = 0 + kb = 0 + mb = m + + 40 if ( kb .eq. mb ) go to 170 + kb = kb + 1 + i = b(kb) + if ( ibound .eq. 0) go to 50 + zcap = zz(i) + vzcap = vz(i) + czcap = cz(i) + vcap = v(i) + if ( s .ge. zz(i) ) go to 50 + vz(i) = vz(i) - p(s) + cz(i) = cz(i) + w(s) + 50 j = zz(i) + cr(i) = cz(i) + v(i) = vz(i) + 60 if ( cr(i) .lt. minw(j) ) go to 70 + if ( cr(i)*p(j)/w(j) .ge. 1 ) go to 80 + 70 zz(i) = j + cz(i) = cr(i) + vz(i) = v(i) + go to 140 + 80 if ( w(j) .gt. cr(i) ) go to 90 + cr(i) = cr(i) - w(j) + v(i) = v(i) + p(j) + a(i,j) = 1 + ioz = j + j = j + 1 + go to 60 + 90 if ( j .ne. jstar ) go to 100 + a(i,j) = 0 + j = j + 1 + go to 60 + 100 zz(i) = j + cz(i) = cr(i) + vz(i) = v(i) + 110 if ( cr(i) .lt. minw(j) ) go to 140 + if ( cr(i)*p(j)/w(j) .lt. 1 ) go to 140 + if ( w(j) .gt. cr(i) ) go to 120 + cr(i) = cr(i) - w(j) + v(i) = v(i) + p(j) + a(i,j) = 1 + ioz = j + go to 130 + 120 a(i,j) = 0 + 130 j = j + 1 + go to 110 + 140 jo = oz(i) + if ( jo .lt. j ) go to 160 + do 150 q=j,jo + a(i,q) = 0 + 150 continue + 160 oz(i) = ioz + if ( ibound .eq. 0 ) go to 40 + if ( vcap - v(i) .le. d ) go to 40 + d = vcap - v(i) + istar = i + zstar = zcap + vzstar = vzcap + czstar = czcap + go to 40 + 170 if ( ibound .eq. 1 ) go to 180 + j = jstar + go to 210 + 180 z = z + p(s) + x(s) = istar + 190 if ( x(jstar) .eq. mp1 ) go to 200 + jstar = jstar + 1 + go to 190 + 200 mb = 0 + kb = 0 + ibound = 0 + i = istar + zz(i) = zstar + vz(i) = vzstar + cz(i) = czstar + go to 50 + 210 if ( j .gt. n ) return + mb = 0 + do 220 i=1,m + ifb(i) = 0 + if ( a(i,j) .eq. 0 ) go to 220 + mb = mb + 1 + b(mb) = i + ifb(i) = 1 + 220 continue + kb = 0 + if ( mb .le. 1 ) go to 240 + ibound = 1 + s = j + d = - inf + jstar = j + 1 + do 230 i=1,m + if ( zz(i) .ge. jstar ) go to 230 + zz(i) = jstar + if ( ifb(i) .eq. 0 ) go to 230 + vz(i) = vz(i) + p(s) + cz(i) = cz(i) - w(s) + 230 continue + go to 40 + 240 if ( mb .eq. 0 ) go to 250 + i = b(1) + z = z + p(j) + x(j) = i + if ( j .lt. zz(i) ) go to 250 + zz(i) = j + 1 + cz(i) = cz(i) - w(j) + vz(i) = vz(i) + p(j) + 250 j = j + 1 + go to 210 + end + subroutine mpsort(na,a,i1,i2,it,v) + +c*********************************************************************72 +c +cc MPSORT rearranges a(i1:i2) so a(it+i1-1) contains the it-th smallest element. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + dimension a(na) + i = i1 + j = i2 + ita = it + i1 - 1 + 10 if ( i .lt. j ) go to 20 + v = a(ita) + return + 20 irr = i + ij = (i + j)/2 + ap = a(ij) + if ( a(i) .le. ap ) go to 30 + a(ij) = a(i) + a(i) = ap + ap = a(ij) + 30 ill = j + if ( a(j) .ge. ap ) go to 50 + a(ij) = a(j) + a(j) = ap + ap = a(ij) + if ( a(i) .le. ap ) go to 50 + a(ij) = a(i) + a(i) = ap + ap = a(ij) + go to 50 + 40 a(ill) = a(irr) + a(irr) = aux + 50 ill = ill - 1 + if ( a(ill) .gt. ap ) go to 50 + aux = a(ill) + 60 irr = irr + 1 + if ( a(irr) .lt. ap ) go to 60 + if ( irr .le. ill ) go to 40 + if ( ita .lt. irr ) go to 70 + i = irr + go to 80 + 70 j = ill + 80 if ( j - i .gt. 10 ) go to 20 + if ( i .eq. i1 ) go to 10 + i = i - 1 + 90 i = i + 1 + if ( i .ne. j ) go to 100 + v = a(ita) + return + 100 ap = a(i+1) + if ( a(i) .le. ap ) go to 90 + irr = i + 110 a(irr+1) = a(irr) + irr = irr - 1 + if ( ap .lt. a(irr) ) go to 110 + a(irr+1) = ap + go to 90 + end + subroutine mt1(n,p,w,c,z,x,jdim,jck,xx,min,psign,wsign,zsign) + +c*********************************************************************72 +c +cc MT1 solves the 0-1 single knapsack problem. +c +c maximize z = p(1)*x(1) + ... + p(n)*x(n) +c +c subject to: w(1)*x(1) + ... + w(n)*x(n) .le. c , +c x(j) = 0 or 1 for j=1,...,n. +c +c the program implements the branch-and-bound algorithm described in +c section 2.5.2 . +c the program derives from an earlier code presented in +c s. martello, p. toth, "algorithm for the solution of the 0-1 single +c knapsack problem", computing, 1978. +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdim - 1 ; +c 2) p(j), w(j), c positive integers; +c 3) max (w(j)) .le. c ; +c 4) w(1) + ... + w(n) .gt. c ; +c 5) p(j)/w(j) .ge. p(j+1)/w(j+1) for j=1,...,n-1. +c +c mt1 calls 1 procedure: chmt1. +c +c the program is completely self-contained and communication to it is +c achieved solely through the parameter list of mt1. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mt1 needs 8 arrays ( p , w , x , xx , min , psign , wsign +c and zsign ) of length at least n + 1 . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c n = number of items; +c p(j) = profit of item j (j=1,...,n); +c w(j) = weight of item j (j=1,...,n); +c c = capacity of the knapsack; +c jdim = dimension of the 8 arrays; +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c z = value of the optimal solution if z .gt. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c x(j) = 1 if item j is in the optimal solution, +c = 0 otherwise. +c +c arrays xx, min, psign, wsign and zsign are dummy. +c +c all the parameters are integer. on return of mt1 all the input +c parameters are unchanged. +c + integer p(jdim),w(jdim),x(jdim),c,z + integer xx(jdim),min(jdim),psign(jdim),wsign(jdim),zsign(jdim) + integer ch,chs,diff,profit,r,t + z = 0 + if ( jck .eq. 1 ) call chmt1(n,p,w,c,z,jdim) + if ( z .lt. 0 ) return +c +c initialize. +c + ch = c + ip = 0 + chs = ch + do ll=1,n + if ( w(ll) .gt. chs ) go to 20 + ip = ip + p(ll) + chs = chs - w(ll) + end do + + 20 ll = ll - 1 + if ( chs .eq. 0 ) go to 50 + p(n+1) = 0 + w(n+1) = ch + 1 + lim = ip + chs*p(ll+2)/w(ll+2) + a = w(ll+1) - chs + b = ip + p(ll+1) + lim1 = b - a*float(p(ll))/float(w(ll)) + if ( lim1 .gt. lim ) lim = lim1 + mink = ch + 1 + min(n) = mink + do j=2,n + kk = n + 2 - j + if ( w(kk) .lt. mink ) mink = w(kk) + min(kk-1) = mink + end do + + do j=1,n + xx(j) = 0 + end do + + z = 0 + profit = 0 + lold = n + ii = 1 + go to 170 + 50 z = ip + do j=1,ll + x(j) = 1 + end do + nn = ll + 1 + do j=nn,n + x(j) = 0 + end do + return +c +c try to insert the ii-th item into the current solution. +c + 80 if ( w(ii) .le. ch ) go to 90 + ii1 = ii + 1 + if ( z .ge. ch*p(ii1)/w(ii1) + profit ) go to 280 + ii = ii1 + go to 80 +c +c build a new current solution. +c + 90 ip = psign(ii) + chs = ch - wsign(ii) + in = zsign(ii) + do ll=in,n + if ( w(ll) .gt. chs ) go to 160 + ip = ip + p(ll) + chs = chs - w(ll) + end do + + ll = n + 110 if ( z .ge. ip + profit ) go to 280 + z = ip + profit + nn = ii - 1 + do 120 j=1,nn + x(j) = xx(j) + 120 continue + do 130 j=ii,ll + x(j) = 1 + 130 continue + if ( ll .eq. n ) go to 150 + nn = ll + 1 + do 140 j=nn,n + x(j) = 0 + 140 continue + 150 if ( z .ne. lim ) go to 280 + return + 160 iu = chs*p(ll)/w(ll) + ll = ll - 1 + if ( iu .eq. 0 ) go to 110 + if ( z .ge. profit + ip + iu ) go to 280 +c +c save the current solution. +c + 170 wsign(ii) = ch - chs + psign(ii) = ip + zsign(ii) = ll + 1 + xx(ii) = 1 + nn = ll - 1 + if ( nn .lt. ii) go to 190 + do 180 j=ii,nn + wsign(j+1) = wsign(j) - w(j) + psign(j+1) = psign(j) - p(j) + zsign(j+1) = ll + 1 + xx(j+1) = 1 + 180 continue + 190 j1 = ll + 1 + do j=j1,lold + wsign(j) = 0 + psign(j) = 0 + zsign(j) = j + end do + lold = ll + ch = chs + profit = profit + ip + if ( ll - (n - 2) ) 240, 220, 210 + 210 ii = n + go to 250 + 220 if ( ch .lt. w(n) ) go to 230 + ch = ch - w(n) + profit = profit + p(n) + xx(n) = 1 + 230 ii = n - 1 + go to 250 + 240 ii = ll + 2 + if ( ch .ge. min(ii-1) ) go to 80 +c +c save the current optimal solution. +c + 250 if ( z .ge. profit ) go to 270 + z = profit + do j=1,n + x(j) = xx(j) + end do + if ( z .eq. lim ) return + 270 if ( xx(n) .eq. 0 ) go to 280 + xx(n) = 0 + ch = ch + w(n) + profit = profit - p(n) +c +c backtrack. +c + 280 nn = ii - 1 + if ( nn .eq. 0 ) return + do j=1,nn + kk = ii - j + if ( xx(kk) .eq. 1 ) go to 300 + end do + return + 300 r = ch + ch = ch + w(kk) + profit = profit - p(kk) + xx(kk) = 0 + if ( r .lt. min(kk) ) go to 310 + ii = kk + 1 + go to 80 + 310 nn = kk + 1 + ii = kk +c +c try to substitute the nn-th item for the kk-th. +c + 320 if ( z .ge. profit + ch*p(nn)/w(nn) ) go to 280 + diff = w(nn) - w(kk) + if ( diff ) 370, 330, 340 + 330 nn = nn + 1 + go to 320 + 340 if ( diff .gt. r ) go to 330 + if ( z .ge. profit + p(nn) ) go to 330 + z = profit + p(nn) + do j=1,kk + x(j) = xx(j) + end do + jj = kk + 1 + do j=jj,n + x(j) = 0 + end do + x(nn) = 1 + if ( z .eq. lim ) return + r = r - diff + kk = nn + nn = nn + 1 + go to 320 + 370 t = r - diff + if ( t .lt. min(nn) ) go to 330 + if ( z .ge. profit + p(nn) + t*p(nn+1)/w(nn+1)) go to 280 + ch = ch - w(nn) + profit = profit + p(nn) + xx(nn) = 1 + ii = nn + 1 + wsign(nn) = w(nn) + psign(nn) = p(nn) + zsign(nn) = ii + n1 = nn + 1 + + do j=n1,lold + wsign(j) = 0 + psign(j) = 0 + zsign(j) = j + end do + + lold = nn + go to 80 + end + subroutine mt1r ( n, p, w, c, eps, z, x, jdim, jck, xx, min, + & psign, wsign, zsign, crc, crp ) + +c*********************************************************************72 +c +cc MT1R solves the 0-1 single knapsack problem with real parameters. +c +c maximize z = p(1)*x(1) + ... + p(n)*x(n) +c +c subject to: w(1)*x(1) + ... + w(n)*x(n) .le. c , +c x(j) = 0 or 1 for j=1,...,n. +c +c the program implements the branch-and-bound algorithm described in +c section 2.5.2 . +c the program is a modified version of subroutine mt1. +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdim - 1 ; +c 2) p(j), w(j), c positive reals; +c 3) max (w(j)) .le. c ; +c 4) w(1) + ... + w(n) .gt. c ; +c 5) p(j)/w(j) .ge. p(j+1)/w(j+1) for j=1,...,n-1. +c +c mt1r calls 1 procedure: chmt1r. +c +c the program is completely self-contained and communication to it is +c achieved solely through the parameter list of mt1r. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mt1r needs 10 arrays ( p , w , x , xx , min , psign , wsign , +c zsign , crc and crp ) of length at least +c n + 1 . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c +c n = number of items; +c p(j) = profit of item j (j=1,...,n); +c w(j) = weight of item j (j=1,...,n); +c c = capacity of the knapsack; +c eps = tolerance (two positive values q and r are considered equal +c if abs(q-r)/max(q,r) .le. eps ); +c jdim = dimension of the 10 arrays; +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c z = value of the optimal solution if z .gt. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c x(j) = 1 if item j is in the optimal solution, +c = 0 otherwise; +c +c arrays xx, min, psign, wsign, zsign, crc and crp are dummy. +c +c parameters n, x, jdim, jck, xx and zsign are integer. parameters p, +c w, c, z, min, psign, wsign, crc, crp and eps are real. on return of +c mt1r all the input parameters are unchanged. +c + real p(jdim),w(jdim) + integer x(jdim) + integer xx(jdim),zsign(jdim) + real min(jdim),psign(jdim),wsign(jdim),crc(jdim),crp(jdim) + real lim,lim1,ip,mink,iu + z = 0. + if ( jck .eq. 1 ) call chmt1r(n,p,w,c,z,jdim) + if ( z .lt. 0. ) return +c +c initialize. +c + ip = 0. + chs = c + eps*c + do ll=1,n + if ( w(ll) .gt. chs ) go to 20 + ip = ip + p(ll) + chs = chs - w(ll) + end do + + 20 ll = ll - 1 + if ( chs .le. 0. ) go to 50 + p(n+1) = - 4.*ip*c + w(n+1) = 2.*c + lim = ip + chs*p(ll+2)/w(ll+2) + a = w(ll+1) - chs + b = ip + p(ll+1) + lim1 = b - a*p(ll)/w(ll) + if ( lim1 .gt. lim ) lim = lim1 + epsp = eps*ip + lim = lim - epsp + mink = 2.*c + min(n) = mink + do j=2,n + kk = n + 2 - j + if ( w(kk) .lt. mink ) mink = w(kk) + min(kk-1) = mink + end do + do j=1,n + xx(j) = 0 + end do + ch = c + eps*c + profit = 0. + lold = n + jj = 1 + nm2 = n - 2 + go to 180 + 50 z = ip + do j=1,ll + x(j) = 1 + end do + nn = ll + 1 + do j=nn,n + x(j) = 0 + end do + return +c +c try to insert the ii-th item into the current solution. +c + 80 jj = ii + ch = crc(ii) + profit = crp(ii) + 90 if ( w(jj) .le. ch ) go to 100 + jj1 = jj + 1 + if ( z + epsp .ge. ch*p(jj1)/w(jj1) + profit ) go to 290 + jj = jj1 + go to 90 +c +c build a new current solution. +c + 100 ip = psign(jj) + chs = ch - wsign(jj) + in = zsign(jj) + do 110 ll=in,n + if ( w(ll) .gt. chs ) go to 170 + ip = ip + p(ll) + chs = chs - w(ll) + 110 continue + ll = n + 120 if ( z .ge. profit + ip ) go to 290 + z = profit + ip + nn = jj - 1 + do 130 j=1,nn + x(j) = xx(j) + 130 continue + do 140 j=jj,ll + x(j) = 1 + 140 continue + if ( ll .eq. n ) go to 160 + nn = ll + 1 + do 150 j=nn,n + x(j) = 0 + 150 continue + 160 if ( z .le. lim ) go to 290 + go to 400 + 170 iu = chs*p(ll)/w(ll) + ll = ll - 1 + if ( iu .le. epsp ) go to 120 + if ( z + epsp .ge. profit + ip + iu ) go to 290 +c +c save the current solution. +c + 180 ii = jj + crc(ii) = ch + crp(ii) = profit + crc(ii+1) = crc(ii) - w(ii) + crp(ii+1) = crp(ii) + p(ii) + nn = ll - 1 + j1 = ll + 1 + if ( nn .lt. ii) go to 200 + do 190 j=ii,nn + jp1 = j + 1 + crc(j+2) = crc(jp1) - w(jp1) + crp(j+2) = crp(jp1) + p(jp1) + 190 continue + 200 profit = crp(ll+1) + do 210 j=j1,lold + wsign(j) = 0. + psign(j) = 0. + zsign(j) = j + 210 continue + lold = ll + nel = ll - ii + 1 + do 220 jj=1,nel + j = j1 - jj + wsign(j) = wsign(j+1) + w(j) + psign(j) = psign(j+1) + p(j) + zsign(j) = j1 + xx(j) = 1 + 220 continue + if ( ll .le. nm2 ) go to 230 + ii = n + go to 260 + 230 crc(ll+2) = crc(ll+1) + crp(ll+2) = crp(ll+1) + if ( ll .lt. nm2 ) go to 250 + if ( crc(n) .lt. w(n) ) go to 240 + profit = profit + p(n) + xx(n) = 1 + 240 ii = n - 1 + go to 260 + 250 ii = ll + 2 + if ( crc(ll+2) .ge. min(ii-1) ) go to 80 +c +c save the current optimal solution. +c + 260 if ( z .ge. profit ) go to 280 + z = profit + do 270 j=1,n + x(j) = xx(j) + 270 continue + if ( z .ge. lim ) go to 400 + 280 xx(n) = 0 +c +c backtrack. +c + 290 nn = ii - 1 + if ( nn .eq. 0 ) go to 400 + do 300 j=1,nn + kk = ii - j + if ( xx(kk) .eq. 1 ) go to 310 + 300 continue + go to 400 + 310 r = crc(kk+1) + crc(kk+1) = crc(kk) + crp(kk+1) = crp(kk) + ch = crc(kk) + profit = crp(kk) + xx(kk) = 0 + if ( r .lt. min(kk) ) go to 320 + ii = kk + 1 + go to 80 + 320 nn = kk + 1 + ii = kk +c +c try to substitute the nn-th item for the kk-th. +c + 330 if ( z + epsp .ge. profit + ch*p(nn)/w(nn) ) go to 290 + diff = w(nn) - w(kk) + if ( diff ) 380, 340, 350 + 340 nn = nn + 1 + go to 330 + 350 if ( diff .gt. r ) go to 340 + if ( z + epsp .ge. profit + p(nn) ) go to 340 + z = profit + p(nn) + do 360 j=1,kk + x(j) = xx(j) + 360 continue + jj = kk + 1 + do 370 j=jj,n + x(j) = 0 + 370 continue + x(nn) = 1 + if ( z .ge. lim ) go to 400 + r = ch - w(nn) + kk = nn + nn = nn + 1 + go to 330 + 380 t = ch - w(nn) + if ( t .lt. min(nn) ) go to 340 + if ( z + epsp .ge. profit + p(nn) + t*p(nn+1)/w(nn+1) ) go to 290 + crc(nn) = ch + crp(nn) = profit + crc(nn+1) = ch - w(nn) + crp(nn+1) = profit + p(nn) + xx(nn) = 1 + ii = nn + 1 + wsign(nn) = w(nn) + psign(nn) = p(nn) + zsign(nn) = ii + n1 = nn + 1 + do 390 j=n1,lold + wsign(j) = 0. + psign(j) = 0. + zsign(j) = j + 390 continue + lold = nn + go to 80 + 400 return + end + subroutine mt2 ( n, p, w, c, z, x, jdim, jfo, jfs, jck, jub, + & ia1, ia2, ia3, ia4, ra ) + +c*********************************************************************72 +c +cc MT2 solves the 0-1 single knapsack problem. +c +c maximize z = p(1)*x(1) + ... + p(n)*x(n) +c +c subject to: w(1)*x(1) + ... + w(n)*x(n) .le. c , +c x(j) = 0 or 1 for j=1,...,n. +c +c the program implements the enumerative algorithm described in +c section 2.9.3 . +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdim - 3 ; +c 2) p(j), w(j), c positive integers; +c 3) max (w(j)) .le. c ; +c 4) w(1) + ... + w(n) .gt. c ; +c +c and, if jfs = 1 , +c +c 5) p(j)/w(j) .ge. p(j+1)/w(j+1) for j=1,...,n-1. +c +c mt2 calls 9 procedures: chmt2, core, cores, fmed, kp01m, newb, +c redns, reds and sortr. +c +c the program is completely self-contained and communication to it is +c achieved solely through the parameter list of mt2. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mt2 needs 8 arrays ( p , w , x , ia1 , ia2 , ia3 , ia4 and +c ra ) of length at least n + 3 . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c +c n = number of items; +c p(j) = profit of item j (j=1,...,n); +c w(j) = weight of item j (j=1,...,n); +c c = capacity of the knapsack; +c jdim = dimension of the 8 arrays; +c jfo = 1 if optimal solution is required, +c = 0 if approximate solution is required; +c jfs = 1 if the items are already sorted according +c to decreasing profit per unit weight, +c = 0 otherwise; +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c z = value of the solution found if z .gt. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c x(j) = 1 if item j is in the solution found, +c = 0 otherwise; +c jub = upper bound on the optimal solution value (to evaluate z +c when jfo=0). +c +c arrays ia1, ia2, ia3, ia4 and ra are dummy. +c +c all the parameters but ra are integer. on return of mt2 all the +c input parameters are unchanged. +c + integer p(jdim),w(jdim),x(jdim),c,z + integer ia1(jdim),ia2(jdim),ia3(jdim),ia4(jdim) + real ra(jdim) + integer fn1,fn0 + z = 0 + jub = 0 + if ( jck .eq. 1 ) call chmt2(n,p,w,c,jfs,z,jdim) + if ( z .lt. 0 ) return +c +c step 1 (initialization and definition of the core problem). +c + jds = jdim/3 + np1 = n + 1 +c +c on return of core or cores, assuming that n1 (n0) is the set of items +c temporarily included in (excluded from) the solution, we have: +c iz1 = total profit of items in set n1; +c icw = c - total weight of items in set n1; +c minw0 = minimum weight of items in set n0; +c ia2(1) to ia2(nnf) = items in the core problem (free items); +c ia1(i) = successor of item i in sets n0 and n1 (= n + 1 if last); +c fn1 = pointer to the first item in set n1 (= n + 1 if empty); +c fn0 = pointer to the first item in set n0 (= n + 1 if empty); +c ra(i) = p(i)/w(i). +c + if ( jfs .eq. 0 ) go to 10 + call cores(n,p,w,c,jfo,iz1,icw,minw0,jdim,ia2,nnf,ia1,fn1,fn0,ra) + go to 20 + 10 call core(n,p,w,c,jfo,iz1,icw,minw0,jdim,ia2,nnf,ia1,fn1,fn0,ra) + 20 if ( nnf .eq. n ) go to 130 + if ( nnf .gt. jds ) go to 130 +c +c step 2 (heuristic solution through the core problem). +c +c sort the items in the core problem. +c + call sortr(nnf,ra,ia2,jdim) +c +c solve the core problem, through kp01m, with: +c ia3(1) to ia3(nnf) = sorted profits of free items; +c ia3(nnf+2) to ia3(2*nnf+1) = dummy for ps; +c ia4(1) to ia4(nnf) = sorted weights of free items; +c ia4(nnf+2) to ia4(2*nnf+1) = dummy for ws; +c ia2(1) to ia2(nnf) = pointers to free items; on input they are +c .gt. 0 ; on output they are .gt. 0 (.lt. 0) +c if the corresponding item is set to 1 (to 0); +c ia2(nnf+2) to ia2(2*nnf+1) = dummy for zs; +c ia2(2*nnf+2) to ia2(3*nnf+1) = dummy for xx; +c ra(1) to ra(nnf) = dummy for minw; +c izc (on output) = solution value of the core problem; +c iubf0 (on output) = upper bound on the problem defined by the free +c items and the items in n0. + np2 = nnf + 2 + n2p2 = 2*nnf + 2 + n2p1 = 2*nnf + 1 + do i=1,nnf + j = ia2(i) + ia3(i) = p(j) + ia4(i) = w(j) + end do + izc = 0 + iubf0 = 0 + call kp01m(nnf,ia3,ia4,icw,minw0,izc,ia2,jfo,iubf0,nnf+1, + & ia2(n2p2),ia3(np2),ia4(np2),ia2(np2),ra) +c +c jub = upper bound on the original problem. +c + jub = iz1 + iubf0 +c +c define the heuristic solution of value iz1 + izc. +c + z = iz1 + izc + icwr = icw + jval = 1 + j = fn1 + 40 if ( j .gt. n ) go to 50 + x(j) = jval + j = ia1(j) + go to 40 + 50 if ( jval .eq. 0 ) go to 60 + jval = 0 + j = fn0 + go to 40 + + 60 continue + + do 80 i=1,nnf + j = ia2(i) + if ( j .lt. 0 ) go to 70 + x(j) = 1 + icwr = icwr - w(j) + go to 80 + 70 mj = - j + x(mj) = 0 + ia2(i) = mj + 80 continue + if ( icwr .lt. minw0 ) go to 110 +c +c the solution is not maximal. +c + j = fn0 + 90 if ( j .gt. n ) go to 110 + if ( w(j) .gt. icwr ) go to 100 + x(j) = 1 + z = z + p(j) + icwr = icwr - w(j) + if ( icwr .lt. minw0 ) go to 110 + 100 j = ia1(j) + go to 90 +c +c halting test. +c + 110 if ( z .eq. jub ) go to 280 + if ( jfo .eq. 0 ) go to 280 +c +c step 3 (reduction, without sorting, of the items not in core). +c + nnfo = nnf +c +c on return of redns, assuming that n1 (n0) is the set of items included +c in (excluded from) the solution, the meaning of the parameters is the +c same given at step 1. +c + call redns(n,p,w,izc,iz1,icw,ia2,nnfo,nnf,ia1,fn1,fn0) +c +c halting test. +c + if ( nnf .eq. nnfo ) go to 280 +c +c items previously fixed are now free. sort the free items. +c + izn = z - iz1 - 1 + do 120 i=1,nnf + j = ia2(i) + ra(j) = float(p(j))/float(w(j)) + x(j) = 2 + 120 continue + call sortr(nnf,ra,ia2,jdim) + go to 160 +c +c step 4 (reduction, with preliminar sorting, of the original problem). +c +c sort the items in the original problem and define: +c ia1(1) to ia1(n) = pointers to the original items; +c ia3(1) to ia3(n) = sorted profits; +c ia4(1) to ia4(n) = sorted weights. +c + 130 do 140 j=1,n + ia1(j) = j + 140 continue + if ( jfs .eq. 0 ) call sortr(n,ra,ia1,jdim) + do 150 i=1,n + j = ia1(i) + ia3(i) = p(j) + ia4(i) = w(j) + 150 continue +c +c on return of reds: +c x(j) = 0, 1 or 2 for item j fixed to 0, to 1 or free; +c ia2(1) to ia2(nnf) = pointers to free items; +c izh = heuristic solution; +c icw = c - total weight of items fixed to 1; +c iz1 = total profit of items fixed to 1. +c + call reds(n,ia3,ia4,p,w,c,ia1,np1,nnf,x,iz1,izh,icw,ia2) + izn = izh - iz1 - 1 +c +c halting test. +c + if ( nnf .gt. 0 ) go to 160 + z = izh + go to 280 + 160 if ( nnf .gt. jds ) go to 200 +c +c step 5 (exact solution of the reduced problem if nnf is small). +c +c solve the reduced problem, through kp01m, with: +c ia3(1) to ia3(nnf) = sorted profits of free items; +c ia3(nnf+2) to ia3(2*nnf+1) = dummy for ps; +c ia4(1) to ia4(nnf) = sorted weights of free items; +c ia4(nnf+2) to ia4(2*nnf+1) = dummy for ws; +c ia2(1) to ia2(nnf) = pointers to free items; on input they are +c .gt. 0 ; on output they are .gt. 0 (.lt. 0) +c if the corresponding item is set to 1 (to 0); +c ia2(nnf+2) to ia2(2*nnf+1) = dummy for zs; +c ia2(2*nnf+2) to ia2(3*nnf+1) = dummy for xx; +c ra(1) to ra(nnf) = dummy for minw; +c izn = solution of the reduced problem. + np2 = nnf + 2 + n2p2 = 2*nnf + 2 + n2p1 = 2*nnf + 1 + do 170 i=1,nnf + j = ia2(i) + ia3(i) = p(j) + ia4(i) = w(j) + ia2(i) = j + 170 continue + iubf0 = - 1 + call kp01m(nnf,ia3,ia4,icw,c+1,izn,ia2,jfo,iubf0,nnf+1, + & ia2(n2p2),ia3(np2),ia4(np2),ia2(np2),ra) +c +c define the optimal solution. +c + z = iz1 + izn + do 190 i=1,nnf + j = ia2(i) + if ( j .lt. 0 ) go to 180 + x(j) = 1 + go to 190 + 180 mj = - j + x(mj) = 0 + 190 continue + go to 280 +c +c step 6 (exact solution of the reduced problem if nnf is large). +c +c solve the reduced problem, through kp01m, with: +c ia3(1) to ia3(nnf) = sorted profits of free items; +c ia3(nnf+2) to ia3(np1) = profits of fixed items; +c ia4(1) to ia4(nnf) = sorted weights of free items; +c ia4(nnf+2) to ia4(np1) = weights of fixed items; +c ia2 = pointers to the original items; +c ia2(1) to ia2(nnf) correspond to free items; on input they +c are .gt. 0 ; on output they are .gt. 0 +c (.lt. 0) if the corresponding item is +c set to 1 (to 0); +c ia2(nnf+1) to ia2(n) correspond to fixed items; they are +c .gt. 0 (.lt. 0) if the corresponding +c item is fixed to 1 (to 0); +c p(1) to p(nnf) = dummy for xx; +c w(1) to w(nnf) = dummy for ps; +c x(1) to x(nnf) = dummy for ws; +c ia1(1) to ia1(nnf) = dummy for zs; +c ra(1) to ra(nnf) = dummy for minw; +c izn = solution of the reduced problem. +c + 200 jl = n + 2 + do 220 j=1,n + if ( x(j) .eq. 2 ) go to 220 + jl = jl - 1 + ia3(jl) = p(j) + ia4(jl) = w(j) + if ( x(j) .eq. 0 ) go to 210 + ia2(jl-1) = j + go to 220 + 210 ia2(jl-1) = - j + 220 continue + do 230 i=1,nnf + j = ia2(i) + ia3(i) = p(j) + ia4(i) = w(j) + 230 continue + iubf0 = - 1 + call kp01m(nnf,ia3,ia4,icw,icw+1,izn,ia2,jfo,iubf0,nnf+1, + & p,w,x,ia1,ra) +c +c reset the original problem and define the optimal solution. +c + z = iz1 + izn + do 270 i=1,n + j = ia2(i) + if ( j .lt. 0 ) go to 240 + x(j) = 1 + go to 250 + 240 j = - j + x(j) = 0 + 250 if ( i .gt. nnf ) go to 260 + p(j) = ia3(i) + w(j) = ia4(i) + go to 270 + 260 p(j) = ia3(i+1) + w(j) = ia4(i+1) + 270 continue + 280 if ( jub .eq. 0 ) jub = z + return + end + subroutine mtb2(n,p,w,b,c,z,x,jdim1,jdim2,jfo,jfs,jck,jub, + & id1,id2,id3,id4,id5,id6,id7,rd8) + +c*********************************************************************72 +c +cc MTB2 solves the bounded single knapsack problem +c +c maximize z = p(1)*x(1) + ... + p(n)*x(n) +c +c subject to: w(1)*x(1) + ... + w(n)*x(n) .le. c , +c 0 .le. x(j) .le. b(j) for j=1,...,n, +c x(j) integer for j=1,...,n. +c +c the program implements the transformation method described in +c section 3.2 . +c +c the problem is transformed into an equivalent 0-1 knapsack +c problem and then solved through subroutine mt2. the user +c must link mt2 and its subroutines to this program. +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdim1 - 1 ; +c 2) p(j), w(j), b(j), c positive integers; +c 3) max (b(j)*w(j)) .le. c ; +c 4) b(1)*w(1) + ... + b(n)*w(n) .gt. c ; +c 5) 2 .le. n + ( log2(b(1)) + ... + log2(b(n)) ) .le. jdim2 - 3 ; +c +c and, if jfs = 1 , +c +c 6) p(j)/w(j) .ge. p(j+1)/w(j+1) for j=1,...,n-1. +c +c mtb2 calls 4 procedures: chmtb2, sol, trans and mt2 (external). +c +c communication to the program is achieved solely through the parameter +c list of mtb2. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mtb2 needs +c 4 arrays ( p , w , b and x ) of length at least jdim1 ; +c 8 arrays ( id1 , id2 , id3 , id4 , id5 , id6 , id7 and +c rd8 ) of length at least jdim2 . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c n = number of item types; +c p(j) = profit of each item of type j (j=1,...,n); +c w(j) = weight of each item of type j (j=1,...,n); +c b(j) = number of items of type j available (j=1,...,n); +c c = capacity of the knapsack; +c jdim1 = dimension of p, w, b, x; +c jdim2 = dimension of id1, id2, id3, id4, id5, id6, id7, rd8. +c jfo = 1 if optimal solution is required, +c = 0 if approximate solution is required; +c jfs = 1 if the items are already sorted according to +c decreasing profit per unit weight (suggested +c for large b(j) values), +c = 0 otherwise; +c jck = 1 if check on the input data is desired, +c = 0 otherwise; +c +c meaning of the output parameters: +c z = value of the solution found if z .gt. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c x(j) = number of items of type j in the solution found; +c jub = upper bound on the optimal solution value (to evaluate z +c when jfo=0). +c +c arrays id1, id2, id3, id4, id5, id6, id7 and rd8 are dummy. +c +c all the parameters but rd8 are integer. on return of mtb2 all the +c input parameters are unchanged. +c + integer p(jdim1),w(jdim1),b(jdim1),x(jdim1),c,z + integer id1(jdim2),id2(jdim2),id3(jdim2),id4(jdim2),id5(jdim2), + & id6(jdim2),id7(jdim2) + real rd8(jdim2) + z = 0 + if ( jck .eq. 1 ) call chmtb2(n,p,w,b,c,jfs,z,jdim1) + if ( z .lt. 0 ) return +c +c transform the bounded knapsack problem into an equivalent +c 0-1 knapsack problem. +c + call trans(n,p,w,b,jdim1,jdim2,nt,id1,id2) + if ( nt .gt. 0 ) go to 10 + z = - 5 + return +c +c solve the equivalent 0-1 knapsack problem. +c + 10 call mt2(nt,id1,id2,c,z,id3,jdim2,jfo,jfs,0,jub, + & id4,id5,id6,id7,rd8) +c +c determine the solution vector for the original problem. +c + call sol(n,b,id3,jdim1,jdim2,x) + return + end + subroutine mtc1(n,w,c,lb,z,x,jdn,jdl,maxbck,xx,m,l) + +c*********************************************************************72 +c +cc MTC1 solves a change-making problem through the branch-and-bound algorithm. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c "optimal and canonical solutions of the change-making problem", +c european journal of operational research, +c 1980. +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdn),x(jdn),c,z + integer xx(jdn),cwf,s,profit + integer m(jdl),l(jdl) + + kbck = 0 + cwf = c + w(n+1) = 1 + jdom = jdl + if ( jdom .ge. w(1) ) jdom = w(1) - 1 + if ( jdom .lt. w(n) ) go to 30 + n2 = n + 2 + + do jj=2,n + j = n2 - jj + k1 = w(j) + k2 = w(j-1) - 1 + if ( k2 .gt. jdom ) k2 = jdom + do k=k1,k2 + m(k) = j + l(k) = 0 + end do + if ( k2 .eq. jdom ) go to 30 + end do + + 30 k1 = w(n) - 1 + if ( k1 .gt. jdom ) k1 = jdom + if ( k1 .eq. 0 ) go to 50 + do k=1,k1 + l(k) = z + end do + 50 xx(1) = c/w(1) + do 60 j=2,n + xx(j) = 0 + 60 continue + profit = xx(1) + c = c - xx(1)*w(1) + ii = 2 +c +c step (2.a). +c + 70 if ( c .le. jdom ) go to 90 + if ( c .lt. w(n) ) go to 150 + iiold = ii + 80 if ( c .ge. w(ii) ) go to 100 + ii = ii + 1 + go to 80 + 90 if ( l(c) .ge. z - profit ) go to 150 + iiold = ii + ii = m(c) +c +c step 2. +c + 100 s = c/w(ii) + ict = c - s*w(ii) + if ( z .le. profit + s + (ict + w(ii+1) - 1)/w(ii+1) ) go to 110 + if ( ict .eq. 0 ) go to 130 + if ( ii .lt. n ) go to 120 + 110 ii = iiold + go to 150 +c +c step 3. +c + 120 c = ict + profit = profit + s + xx(ii) = s + ii = ii + 1 + go to 70 +c +c step 4. +c + 130 z = profit + s + do 140 j=1,n + x(j) = xx(j) + 140 continue + x(ii) = s + if ( z .ne. lb ) go to 150 + c = cwf + return +c +c step 5. +c + 150 kbck = kbck + 1 + if ( kbck .eq. maxbck ) go to 170 + ib = ii - 1 + do 160 j=1,ib + iimj = ii - j + if ( xx(iimj) .gt. 0 ) go to 180 + 160 continue + 170 c = cwf + if ( z .gt. c ) z = 0 + return + 180 kk = ii - j + if ( c .ge. w(kk) ) go to 190 + if ( c .gt. jdom ) go to 190 + if ( z - profit .gt. l(c) ) l(c) = z - profit + 190 c = c + w(kk) + profit = profit - 1 + xx(kk) = xx(kk) - 1 + if ( z .gt. profit + (c + w(kk+1) - 1)/w(kk+1) ) go to 200 + c = c + xx(kk)*w(kk) + profit = profit - xx(kk) + xx(kk) = 0 + ii = kk + 1 + go to 150 + 200 ii = kk + 1 + iiold = ii + if ( c .gt. jdom ) go to 210 + if ( l(c) .ge. z - profit ) go to 150 + 210 if ( c - w(kk) .ge. w(n) ) go to 100 + ih = kk +c +c step 6. +c + 220 ih = ih + 1 + if ( z .le. profit + (c + w(ih) - 1)/w(ih) ) go to 150 + if ( ih .gt. n ) go to 150 + if ( c - w(ih) .lt. w(n) ) go to 220 + ii = ih + iiold = ii + go to 100 + end + subroutine mtc2 ( n, w, c, z, x, jdn, jdl, jfo, jck, xx,wr, pr, + & m, l ) + +c*********************************************************************72 +c +cc MTC2 solves the unbounded change-making problem +c +c minimize z = x(1) + ... + x(n) +c +c subject to: w(1)*x(1) + ... + w(n)*x(n) = c , +c x(j) .ge. 0 and integer for j=1,...,n. +c +c the program implements the enumerative algorithm described in +c section 5.6 . +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdn - 1 ; +c 2) w(j), c positive integers; +c 3) max (w(j)) .lt. c . +c +c mtc2 calls 5 procedures: chmtc2, corec, maxt, mtc1 and sorti. +c +c the program is completely self-contained and communication to it is +c achieved solely through the parameter list of mtc2. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mtc2 needs +c 5 arrays ( w , x , xx , wr and pr ) of length at least +c jdn ; +c 2 arrays ( m and l ) of length at least jdl . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c +c n = number of item types; +c +c w(j) = weight of each item of type j (j=1,...,n); +c +c c = capacity; +c +c jdn = dimension of arrays w , x , xx , wr and pr ; +c +c jdl = dimension of arrays m and l ( suggested value +c jdl = max (w(j)) - 1 ; +c if the core memory is not enough, jdl should be set +c to the largest possible value); +c +c jfo = 1 if optimal solution is required, +c = 0 if approximate solution is required (at most 100000 +c backtrackings are performed); +c +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c +c z = value of the solution found if z .gt. 0 , +c = no feasible solution exists if z .eq. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c +c x(j) = number of items of type j in the solution found. +c +c arrays xx, m, l, wr and pr are dummy. +c +c all the parameters are integer. on return of mtc2 all the input +c parameters are unchanged. +c + integer w(jdn),x(jdn),c,z + integer xx(jdn),wr(jdn),pr(jdn) + integer m(jdl),l(jdl) + integer prj,cws,s1,s2 + + z = c + 1 + + if ( jck .eq. 1 ) then + call chmtc2(n,w,c,z,jdn) + end if + + if ( z .lt. 0 ) then + return + end if + + maxbck = - 1 + + if ( jfo .eq. 0 ) then + maxbck = 100000 + end if +c +c lower bound computation. +c + call maxt(n,w,i1,i2,i3,jdn) + + s1 = c/w(i1) + s2 = (c - s1*w(i1))/w(i2) + ip = s1 + s2 + cws = c - s1*w(i1) - s2*w(i2) + + if ( cws .eq. 0 ) then + + z = ip + do j=1,n + x(j) = 0 + end do + x(i1) = s1 + x(i2) = s2 + return + + end if + + lb = ip + (cws + w(i3) - 1)/w(i3) + l1 = ip - 1 + (cws + w(i1) + w(i2) - 1)/w(i2) + + if ( l1 .lt. lb ) then + lb = l1 + end if + + if ( n .le. 500 ) then + go to 90 + end if +c +c determine and solve the core problem. +c + call corec(n,w,i1,i2,i3,jdn,nc,pr) + call sorti(nc,w,pr,jdn) + + do j=1,nc + prj = pr(j) + wr(j) = w(prj) + end do + + call mtc1(nc,wr,c,lb,z,xx,jdn,jdl,maxbck,x,m,l) + + if ( z .gt. 0 ) go to 40 + z = c + 1 + go to 90 + + 40 continue + + do j=1,n + x(j) = 0 + end do + do j=1,nc + prj = pr(j) + x(prj) = xx(j) + end do +c +c the core problem solution is optimal. +c + if ( z .eq. lb ) then + return + end if + + do j=1,n + xx(j) = x(j) + end do +c +c solve the complete problem. +c + 90 continue + + do j=1,n + pr(j) = j + end do + + call sorti(n,w,pr,jdn) + + do j=1,n + prj = pr(j) + wr(j) = w(prj) + end do + + izh = z + + call mtc1(n,wr,c,lb,z,xx,jdn,jdl,maxbck,x,m,l) + + if ( z .eq. 0 ) then + return + end if +c +c store in x the final solution. +c + if ( z .eq. izh ) then + + do j=1,n + x(j) = xx(j) + end do + + else + + do j=1,n + prj = pr(j) + x(prj) = xx(j) + end do + + end if + + return + end + subroutine mtcb(n,w,b,c,z,x,jdn,jdl,jfo,jck,xx,wr,br,pr,m,l) + +c*********************************************************************72 +c +cc MTCB solves the bounded change-making problem +c +c minimize z = x(1) + ... + x(n) +c +c subject to: w(1)*x(1) + ... + w(n)*x(n) = c , +c 0 .le. x(j) .le. 0 for j=1,...,n, +c x(j) integer for j=1,...,n. +c +c the program implements the branch-and-bound algorithm described +c in section 5.8 . +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdn - 1 ; +c 2) w(j), b(j), c positive integers; +c 3) max (w(j)) .lt. c ; +c 4) b(j)*w(j) .le. c for j=1,...,n; +c 5) b(1)*w(1) + ...+ b(n)*w(n) .gt. c . +c +c mtcb calls 3 procedures: chmtcb, cmpb and sorti. +c +c the program is completely self-contained and communication to it is +c achieved solely through the parameter list of mtcb. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mtcb needs +c 7 arrays ( w , b , x , xx , wr , br and pr ) of length +c at least jdn ; +c 2 arrays ( m and l ) of length at least jdl . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c n = number of item types; +c w(j) = weight of each item of type j (j=1,...,n); +c b(j) = number of available items of type j (j=1,...,n); +c c = capacity; +c jdn = dimension of arrays w , b , x , xx , wr , br and pr ; +c jdl = dimension of arrays m and l (suggested value +c jdl = max (w(j)) - 1 ; +c if the core memory is not enough, jdl should be set +c to the largest possible value); +c jfo = 1 if optimal solution is required, +c = 0 if approximate solution is required (at most 100000 +c backtrackings are performed); +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c z = value of the solution found if z .gt. 0 , +c = no feasible solution exists if z .eq. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c x(j) = number of items of type j in the solution found. +c +c arrays xx, m, l, wr, br and pr are dummy. +c +c all the parameters are integer. on return of mtcb all the input +c parameters are unchanged. +c + integer w(jdn),b(jdn),x(jdn),c,z + integer xx(jdn),wr(jdn),br(jdn),pr(jdn) + integer m(jdl),l(jdl) + z = c + 1 + if ( jck .eq. 1 ) call chmtcb(n,w,b,c,z,jdn) + if ( z .lt. 0 ) return + maxbck = - 1 + if ( jfo .eq. 0 ) maxbck = 100000 +c +c sorting. +c + do j=1,n + pr(j) = j + end do + call sorti(n,w,pr,jdn) + do j=1,n + jpr = pr(j) + wr(j) = w(jpr) + br(j) = b(jpr) + end do +c +c solution. +c + call cmpb(n,wr,br,c,z,xx,jdn,jdl,maxbck,x,m,l) +c +c store in x the final solution. +c + do j=1,n + jpr = pr(j) + x(jpr) = xx(j) + end do + + return + end + subroutine mtg ( n, m, p, w, c, minmax, z, xstar, back, jck, jb ) + +c*********************************************************************72 +c +cc MTG solves the generalized assignment problem +c +c opt z = p(1,1)*x(1,1) + ... + p(1,n)*x(1,n) + +c ... + +c p(m,1)*x(m,1) + ... + p(m,n)*x(m,n) +c +c (where opt = min if minmax = 1 , opt = max if minmax = 2 ) +c +c subject to: +c +c w(i,1)*x(i,1) + ... + w(i,n)*x(i,n) .le. c(i) for i=1,...,m, +c x(1,j) + ... + x(m,j) = 1 for j=1,...,n, +c x(i,j) = 0 or 1 for i=1,...,m, j=1,...,n. +c +c the program implements the branch-and-bound algorithm described +c in sections 7.3 - 7.5 . +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. m .le. jdimr ; +c 2) 2 .le. n .le. jdimc +c ( jdimr and jdimc are defined by the first two executable +c statements); +c 3) m .le. jdimpc +c ( jdimpc , defined by the third executable statement, is used +c for packing array y , and cannot be greater than +c (number of bits of the host) - 2 ; if a higher value is +c desired, subroutines ydef and yuse must be re-structured +c accordingly); +c 4) p(i,j), w(i,j) and c(i) positive integers; +c 5) w(i,j) .le. c(i) for at least one i, for j=1,...,n; +c 6) c(i) .ge. min (w(i,j)) for i=1,...,m. +c +c in addition, it is required that +c +c 7) (maximum level of the decision-tree) .le. jnlev . +c ( jnlev is defined by the fourth executable statement.) +c +c mtg calls 24 procedures: chmtg, defpck, dmind, feas, gha, ghbcd, +c ghx, gr1, gr2, heur, kpmax, kpmin, pen0, +c pen1, prepen, skp1, sorti, sortr, termin, +c trin, ubfjv, ubrs, ydef and yuse. +c if not present in the library of the host, the user must supply an +c integer function iand ( i1, i2 ) which sets iand to the bit-by-bit +c logical and of i1 and i2 . such function is used in subroutines +c ydef and yuse. +c +c communication to the program is achieved solely through the +c parameter list of mtg. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mtg needs +c 17 arrays ( c , dd , ud , q , pakl , ip , ir , il , if , +c wobbl , kq , flrep , dmyr1 , dmyr2 , dmyr3 , +c dmyr4 and dmyr5 ) of length at least m ; +c 25 arrays ( xstar , xs , bs , b , ka , xxs , iobbl , jobbl , +c best , xjjub , ds , dmyc1 , dmyc2 , dmyc3 , +c dmyc4 , dmyc5 , dmyc6 , dmyc7 , dmyc8 , dmyc9 , +c dmyc10 , dmyc11 , dmyc12 , dmyc13 and dmycr1 ) of +c length at least n ; +c 4 arrays ( ps , ws , dmycc1 and dmycc2 ) of length at least +c n + 1 ; +c 6 arrays ( e , cc , cs , type , us and ubl ) of length at +c least jnlev ; +c 7 arrays ( p , w , a , x , pak , kap and mind ) of length +c at least m x n ; +c 5 arrays ( d , vs , v , lb and ub ) of length at least +c jnlev x m ; +c 1 array ( y ) of length at least jnlev x n ; +c 2 arrays ( mask1 and itwo ) of length at least jdimpc . +c +c the arrays are currently dimensioned to allow problems for which +c m .le. 10 , +c n .le. 100 , +c jnlev .le. 150 , +c on a 32-bit computer (so, in the calling program, arrays p and w +c must be dimensioned at (10,100) ). changing such limits necessitates +c changing the dimensions of all the arrays in subroutine mtg and in +c common /pack/ (which is included in subroutines mtg, ydef and yuse), +c as well as the four first executable statements. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c +c n = number of items; +c +c m = number of knapsacks; +c +c p(i,j) = profit of item j if assigned to knapsack i +c (i=1,...,m; j=1,...,n); +c w(i,j) = weight of item j if assigned to knapsack i +c (i=1,...,m; j=1,...,n); +c c(i) = capacity of knapsack i (i=1,...,m); +c minmax = 1 if the objective function must be minimized, +c = 2 if the objective function must be maximized; +c back = - 1 if exact solution is required, +c = maximum number of backtrackings to be performed, +c if heuristic solution is required; +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c z = value of the optimal solution if z .gt. 0 , +c = 0 if no feasible solution exists, +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c xstar(j) = knapsack where item j is inserted in the solution found; +c jb = lower bound (if minmax=1) or upper bound (if minmax=2) +c on the optimal solution value. +c +c all the parameters are integer. on return of mtg all the input +c parameters are unchanged, with the following two exceptions. back +c gives the number of backtrackings performed; p(i,j) is set to 0 +c for all pairs (i,j) such that w(i,j) .gt. c(i) . +c +c meaning of the main internal variables: +c b(j) = 0 if the assignment of item j is fixed, +c = 1 otherwise; +c a(i,j) = 1 if assignment of item j to knapsack i is fixed, +c = - 1 if assignment of item j to knapsack i is prohibited, +c = 0 otherwise; +c x(i,j) = current solution of the relaxed problem; +c y(l,j) = packed solution of the relaxed problem for item j at +c level l of the branch-decision tree. +c + integer p(10,100),w(10,100),c(10),xstar(100),z,back + integer h,s,r,u,su,vc,sb,t,qh,zbound,vjjub,penalt + integer dd(10),ud(10),q(10),pakl(10),ip(10),ir(10),il(10), + & if(10),wobbl(10),kq(10),flrep(10) + integer xs(100),bs(100),b(100),ka(100),xxs(100),iobbl(100), + & jobbl(100),best(100),xjjub(100) + real ds(100) + integer ps(101),ws(101) + integer e(150),cc(150),cs(150),type(150),us(150),ubl(150) + integer a(10,100),x(10,100),pak(10,100),kap(10,100), + & mind(10,100) + integer d(150,10),vs(150,10),v(150,10),lb(150,10),ub(150,10) + integer y + integer dmyr1(10),dmyr2(10),dmyr3(10),dmyr4(10),dmyr5(10) + integer dmyc1(100),dmyc2(100),dmyc3(100),dmyc4(100), + & dmyc5(100),dmyc6(100),dmyc7(100),dmyc8(100), + & dmyc9(100),dmyc10(100),dmyc11(100),dmyc12(100), + & dmyc13(100) + integer dmycc1(101),dmycc2(101) + real dmycr1(100) + + common /pack/ mask1(30),itwo(30),mask,y(150,100) +c +c definition of the internal parameters. +c + jdimr = 10 + jdimc = 100 + jdimpc = 30 + jnlev = 150 + z = 0 + if ( jck .eq. 1 ) call chmtg(n,m,p,w,c,jdimr,jdimc,jdimpc,z) + if ( z .lt. 0 ) return +c +c step 1 (initialize). +c + numnod = 0 + invst = 0 + imult = - 1 + jb = 0 + if ( minmax .eq. 2 ) go to 10 +c +c transform the minimization problem into a maximization problem. +c + call trin(p,n,m,invst,lam,jdimr,jdimc) + imult = 1 +c +c solve the maximization problem. +c +c check for infeasibility. +c + 10 call feas(n,m,p,w,c,xstar,jfi,jdimr,jdimc) + if ( jfi .eq. 1 ) go to 880 +c +c heuristics +c + call heur(p,w,c,n,m,z,xstar,iub,jub,best,kvst,inf, + & jdimr,jdimc,dmyr1,dmyr2,dmyr3,dmyr4,dmyr5, + & dmyc1,dmyc2,dmyc3,dmyc4,dmycr1,a) + if ( z .ge. jub ) go to 880 + if ( back .eq. 0 ) go to 880 +c +c first reduction. +c + call gr1(p,w,c,n,m,z,xstar,iub,best,b,a,nr,kq,kvst,jdimr,jdimc) + if ( nr .eq. 0 ) go to 880 + kub = iub +c +c define the vectors for packing y. +c + call defpck(m,jdimpc) +c +c compute the initial martello-toth bound (su) for the root node. +c + call dmind(n,m,p,w,mind,jdimr,jdimc,dmyc1,dmycr1) + do i=1,m + flrep(i) = 1 + q(i) = kq(i) + end do + 30 su = 0 + do 130 i=1,m + if ( flrep(i) .eq. 1 ) go to 40 + su = su + v(1,i) + go to 130 + 40 lb(1,i) = 1 + v(1,i) = 0 + kk = 0 + isum = 0 + jspr = 0 + do 60 jj=1,n + j = mind(i,jj) + xs(j) = 0 + if ( a(i,j) .eq. (- 1) ) go to 60 + if ( b(j) .eq. 1 ) go to 50 + xs(j) = 1 + jspr = jspr + p(i,j) + go to 60 + 50 if ( w(i,j) .gt. q(i) ) go to 60 + kk = kk + 1 + ws(kk) = w(i,j) + isum = isum + ws(kk) + ps(kk) = p(i,j) + bs(kk) = j + 60 continue + if ( isum .gt. q(i) ) go to 80 + if ( kk .eq. 0 ) go to 90 + do j=1,kk + xxs(j) = 1 + v(1,i) = v(1,i) + ps(j) + end do + go to 90 + 80 mubf = - 1 + call kpmax(kk,ps,ws,q(i),v(1,i),xxs,mubf, + & jdimc+1,jdimc,dmyc1,dmyc2,dmyc3,dmyc4,dmyc5) + 90 v(1,i) = v(1,i) + jspr + su = su + v(1,i) + if ( kk .eq. 0 ) go to 110 + do j=1,kk + index = bs(j) + xs(index) = xxs(j) + end do + 110 do j=1,n + x(i,j) = xs(j) + call ydef(1,i,j,xs(j)) + end do + 130 continue + l = 1 + cc(1) = 1 + d(1,1) = 1 + ub(1,1) = su + jub = su + if ( jub .gt. kub ) jub = kub + if ( jub .le. z ) go to 880 + l = 2 +c +c step 2 (forward step). +c + 140 if ( numnod .eq. back ) go to 880 + numnod = numnod + 1 + if ( numnod .gt. 1 ) go to 150 +c +c compute the fisher-jaikumar-van wassenhove bound (jjub). +c + call ubfjv(n,m,p,w,q,b,a,jjub,xjjub,vjjub,z,inf, + & jdimr,jdimc,jdimc+1,dmyc1,dmyc2,dmyc3,dmycc1, + & dmycc2,dmycr1,dmyc4,dmyc5,dmyc6,dmyc7,dmyc8,dmyc9, + & dmyc10,dmyc11,dmyr1,dmyr2,dmyr3,dmyc12,pak) + go to 160 +c +c compute the improved ross-soland bound (jjub). +c + 150 call ubrs(n,m,p,w,q,b,a,jjub,xjjub,vjjub,z,inf, + & jdimr,jdimc,jdimc+1,dmyr1,dmyc1,dmyc2,dmyc3,dmyc4, + & dmyc5,dmyc6,dmyc7,dmyc8,dmyc9,dmyc10,dmyc11, + & dmyc12,dmyc13,dmycc1,dmycc2,dmycr1) + 160 if ( jjub .le. z ) go to 690 + if ( jjub .ne. vjjub ) go to 180 + z = vjjub + do j=1,n + xstar(j) = xjjub(j) + end do + go to 680 + 180 ubl(l-1) = jjub + if ( l .lt. jnlev ) go to 190 + z = - 7 + go to 880 +c +c search for implied assignments. +c + 190 kobbl = 0 + + do i=1,m + wobbl(i) = 0 + end do + + rz = 0 + do 280 s=1,n + ka(s) = 1 + if ( b(s) .eq. 0 ) go to 280 + rptot = 0 + rp1 = 0 + ka(s) = 0 + kfeas = 0 + do 220 i=1,m + rsum = float(p(i,s))/float(w(i,s)) + if ( x(i,s) .eq. 0 ) go to 210 + ka(s) = ka(s) + 1 + rp1 = rp1 + rsum + rptot = rptot + rsum + kfeas = kfeas + 1 + ifeas = i + go to 220 + 210 rptot = rptot + rsum + if ( a(i,s) .eq. (- 1) ) go to 220 + if ( w(i,s) .gt. q(i) ) go to 220 + kfeas = kfeas + 1 + ifeas = i + 220 continue + if ( kfeas .eq. 0 ) go to 690 + if ( kfeas .gt. 1 ) go to 240 + wobbl(ifeas) = wobbl(ifeas) + w(ifeas,s) + if ( wobbl(ifeas) .gt. q(ifeas) ) go to 690 + if ( x(ifeas,s) .eq. 1 ) go to 230 + rz = inf + j = s + jt = 0 + go to 280 +c +c item s must be inserted into knapsack ifeas. +c + 230 kobbl = kobbl + 1 + iobbl(kobbl) = ifeas + jobbl(kobbl) = s + go to 260 + 240 if ( ka(s) - 1 ) 250,280,260 + 250 ak = rptot/float(m) + go to 270 + 260 ak = rp1 + 270 ds(s) = ak + if ( ak .le. rz ) go to 280 + rz = ak + j = s + jt = ka(s) + 280 continue + if ( rz .le. 0. ) go to 650 + if ( kobbl .eq. 0 ) go to 310 +c +c kobbl particular forward steps. +c + do 300 i=1,kobbl + l1 = l - 1 + ik = iobbl(i) + jk = jobbl(i) + e(l) = jk + cs(l) = 1 + d(l,1) = ik + cc(l) = 1 + b(jk) = 0 + a(ik,jk) = 1 + q(ik) = q(ik) - w(ik,jk) + index = cc(l1) + index = d(l1,index) + ub(l,ik) = ub(l1,index) + ubl(l) = ubl(l1) + type(l) = 1 + do ii=1,m + lb(l,ii) = lb(l1,ii) + v(l,ii) = v(l1,ii) + end do + l = l + 1 + 300 continue + go to 190 + 310 if ( z .eq. kvst ) go to 390 +c +c compute the penalities for the improved martello-toth bound. +c + call prepen(n,m,p,w,q,b,a,mind,pak,kap,pakl,ip,ir,il,if, + & jdimr,jdimc) + izmax = - inf + rzmax = - inf + zbound = 0 + index = cc(l-1) + index = d(l-1,index) + iub = ub(l-1,index) + do 370 jj=1,n + if ( ka(jj) .eq. 1 ) go to 370 + if ( ka(jj) .eq. 0 ) go to 320 + call pen1(jj,m,p,w,x,v,l-1,pak,kap,pakl,ip,ir,il,if,penalt, + & jfo,iub,z,jdimr,jdimc,jnlev) + if ( jfo .eq. 0 ) go to 330 + izmax = inf + rzmax = inf + j = jj + jt = ka(jj) + go to 330 + 320 call pen0(jj,m,p,w,q,a,v,l-1,pak,kap,pakl,ip,ir,il,if, + & penalt,jfo,iub,z,inf,jdimr,jdimc,jnlev) + if ( jfo .gt. 1 ) go to 330 + izmax = inf + rzmax = inf + j = jj + jt = 0 + 330 if ( penalt .le. zbound ) go to 340 + if ( iub - penalt .le. z ) go to 690 + zbound = penalt + 340 if ( penalt .lt. izmax ) go to 370 + if ( penalt .eq. izmax ) go to 350 + izmax = penalt + rzmax = ds(jj) + go to 360 + 350 if ( ds(jj) .le. rzmax ) go to 370 + rzmax = ds(jj) + 360 j = jj + jt = ka(jj) + 370 continue +c +c compute the improved martello-toth bound (iub - zbound). +c + if ( ubl(l-1) .gt. iub - zbound ) ubl(l-1) = iub - zbound + if ( numnod .gt. 1 ) go to 390 + jklim = iub - zbound + if ( jub .gt. ubl(1) ) jub = ubl(1) + if ( jub .gt. jklim ) jub = jklim +c +c second reduction (executed only for the root node). +c + call gr2(n,m,p,w,q,b,a,mind,pak,kap,pakl,ip,ir,il,if,nr,z, + & xstar,ub(1,1),x,v,flrep,kvst,jdimr,jdimc,jnlev,dmyr1) + if ( nr .eq. 0 ) go to 880 +c +c check for re-execution. +c + do 380 i=1,m + if ( flrep(i) .eq. 0 ) go to 380 + numnod = 0 + kub = jub + go to 30 + 380 continue +c +c forward step on item j. +c + 390 e(l) = j + type(l) = jt + t = 0 + vc = 0 + if ( type(l) .gt. 0 ) go to 420 + do 410 i=1,m + if ( w(i,j) .gt. q(i) ) go to 400 + if ( a(i,j) .eq. (- 1) ) go to 400 + t = t + 1 + d(l,t) = i + 400 vc = vc + v(l-1,i) + 410 continue + if ( t .eq. 0 ) go to 690 + go to 450 + 420 do 440 i=1,m + if ( x(i,j) .eq. 0 ) go to 430 + t = t + 1 + d(l,t) = i + go to 440 + 430 vc = vc + v(l-1,i) + 440 continue + 450 cs(l) = t +c +c step 3 (bound). +c +c compute the initial martello-toth bound for the son nodes. +c + kk = 0 + do 560 r=1,t + h = d(l,r) + qh = q(h) + if (type(l) .eq. 0 ) qh = qh - w(h,j) + jw = w(h,j) + w(h,j) = inf + u = 0 + sb = 0 + isu = 0 + do 480 js=1,n + s = mind(h,js) + if ( b(s) .eq. 0 ) go to 460 + if ( w(h,s) .gt. qh ) go to 470 + if ( a(h,s) .ne. 0 ) go to 470 + u = u + 1 + ps(u) = p(h,s) + ws(u) = w(h,s) + sb = sb + ws(u) + bs(u) = s + go to 480 + 460 if ( a(h,s) .ne. 1 ) go to 470 + call ydef(l,h,s,1) + isu = isu + p(h,s) + go to 480 + 470 call ydef(l,h,s,0) + 480 continue + if ( type(l) .gt. 0 ) go to 490 + call ydef(l,h,j,1) + isu = isu + p(h,j) + 490 index = cc(l-1) + ihs = d(l-1,index) + ksu = z - ub(l-1,ihs) + v(l-1,h) - isu + su = ksu + if ( sb .gt. qh ) go to 510 + su = 0 + if ( u .eq. 0 ) go to 540 + do s=1,u + xs(s) = 1 + su = su + ps(s) + end do + go to 520 + 510 mubf = - 1 + call kpmax(u,ps,ws,qh,su,xs,mubf, + & jdimc+1,jdimc,dmyc1,dmyc2,dmyc3,dmyc4,dmyc5) + 520 do s=1,u + js = bs(s) + call ydef(l,h,js,xs(s)) + end do + 540 if ( su .gt. ksu ) go to 550 + if ( type(l) .eq. 0 ) go to 550 + kk = kk + 1 + if ( kk .eq. 1 ) go to 550 + w(h,j) = jw + go to 690 + 550 su = su + isu + vs(l,h) = su + if ( type(l) .gt. 0 ) vc = vc + su + w(h,j) = jw + 560 continue +c +c step 4 (sort the son nodes). +c + us(l) = vc + jsign = 1 + if ( type(l) .eq. 0 ) jsign = - 1 + do r=1,t + h = d(l,r) + jadd = v(l-1,h) - vs(l,h) + ub(l,h) = vc + jadd*jsign + dd(r) = h + ud(h) = ub(l,h) + end do + + call sorti(t,ud,dd,jdimr) + + do r=1,t + d(l,r) = dd(r) + end do +c +c step 5 (first branching from a node). +c + l1 = l - 1 + cc(l) = 1 + h = d(l,1) + if ( ub(l,h) .le. z ) go to 690 + + do i=1,m + lb(l,i) = lb(l1,i) + v(l,i) = v(l1,i) + end do + + if ( type(l) .eq. 0 ) go to 620 + + do u=2,t + r = d(l,u) + lb(l,r) = l + v(l,r) = vs(l,r) + do s=1,n + call yuse(l,r,s,x(r,s)) + end do + end do + + go to 640 + 620 lb(l,h) = l + v(l,h) = vs(l,h) + do s=1,n + call yuse(l,h,s,x(h,s)) + end do + 640 a(h,j) = 1 + b(j) = 0 + q(h) = q(h) - w(h,j) + l = l + 1 + go to 140 +c +c step 6 (update the current optimal solution). +c + 650 l1 = l - 1 + index = cc(l1) + h = d(l1,index) + if ( z .ge. ub(l1,h) ) go to 690 + z = ub(l1,h) + do 670 j=1,n + do 660 i=1,m + if ( x(i,j) .ne. 1 ) go to 660 + xstar(j) = i + go to 670 + 660 continue + 670 continue + 680 if ( z .eq. jub ) go to 880 +c +c step 7 (backtrack and branching for the subsequent son nodes). +c + 690 l = l - 1 + if ( l .le. 1 ) go to 880 + index = cc(l) + h = d(l,index) + j = e(l) + l1 = l - 1 + if ( cc(l) .eq. cs(l) ) go to 700 + jh = d(l,index+1) + if ( ubl(l1) .le. z ) go to 700 + if ( ub(l,jh) .gt. z ) go to 780 + go to 710 + 700 if ( b(j) .eq. 1 ) go to 720 + 710 a(h,j) = 0 + b(j) = 1 + q(h) = q(h) + w(h,j) + 720 t = cs(l) + if ( type(l) .gt. 0 ) go to 750 + ls = lb(l1,h) + lb(l,h) = ls + v(l,h) = v(l1,h) + do 730 u=1,t + index = d(l,u) + a(index,j) = 0 + 730 continue + do s=1,n + call yuse(ls,h,s,x(h,s)) + end do + go to 690 + 750 do 770 u=1,t + r = d(l,u) + if ( r .eq. h ) go to 770 + ls = lb(l1,r) + lb(l,r) = ls + v(l,r) = v(l1,r) + a(r,j) = 0 + do 760 s=1,n + call yuse(ls,r,s,x(r,s)) + 760 continue + 770 continue + go to 690 + 780 a(h,j) = - 1 + q(h) = q(h) + w(h,j) + if ( type(l) .gt. 0 ) go to 810 + ls = lb(l1,h) + lb(l,h) = ls + v(l,h) = v(l1,h) + do s=1,n + call yuse(ls,h,s,x(h,s)) + end do + cc(l) = cc(l) + 1 + index = cc(l) + h = d(l,index) + lb(l,h) = l + v(l,h) = vs(l,h) + do s=1,n + call yuse(l,h,s,x(h,s)) + end do + go to 850 + 810 lb(l,h) = l + v(l,h) = vs(l,h) + do s=1,n + call yuse(l,h,s,x(h,s)) + end do + cc(l) = cc(l) + 1 + index = cc(l) + h = d(l,index) + ls = lb(l1,h) + lb(l,h) = ls + v(l,h) = v(l1,h) + do s=1,n + call yuse(ls,h,s,x(h,s)) + end do + if ( cc(l) .lt. cs(l) ) go to 850 + if ( us(l) .le. z ) go to 850 + if ( cs(l) .eq. m ) go to 850 + do 840 r=1,m + if ( a(r,j) .eq. (- 1) ) go to 840 + if ( w(r,j) .le. q(r) ) go to 860 + 840 continue + 850 a(h,j) = 1 + q(h) = q(h) - w(h,j) + go to 870 + 860 a(h,j) = 0 + b(j) = 1 + 870 l = l + 1 + go to 140 +c +c terminate. +c + 880 call termin(jfi,invst,jub,imult,z,kvst,numnod,minmax, + & m,n,p,lam,jdimr,jdimc,jb,back) + return + end + subroutine mthg ( n, m, p, w, c, minmax, z, xstar, jck ) + +c*********************************************************************72 +c +cc MTHG heuristically solves the generalized assignment problem. +c +c opt z = p(1,1)*x(1,1) + ... + p(1,n)*x(1,n) + +c ... + +c p(m,1)*x(m,1) + ... + p(m,n)*x(m,n) +c +c (where opt = min if minmax = 1 , opt = max if minmax = 2 ) +c +c subject to: +c +c w(i,1)*x(i,1) + ... + w(i,n)*x(i,n) .le. c(i) for i=1,...,m, +c x(1,j) + ... + x(m,j) = 1 for j=1,...,n, +c x(i,j) = 0 or 1 for i=1,...,m, j=1,...,n. +c +c the program is included in the volume +c s. martello, p. toth, "knapsack problems: algorithms +c and computer implementations", john wiley, 1990 +c and implements the polynomial-time algorithms described +c in section 7.4 . +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. m .le. jdimr ; +c 2) 2 .le. n .le. jdimc ; +c ( jdimr and jdimc are defined by the first two executable +c statements;) +c 3) p(i,j), w(i,j) and c(i) positive integers; +c 4) w(i,j) .le. c(i) for at least one i, for j=1,...,n; +c 5) c(i) .ge. min (w(i,j)) for i=1,...,m. +c +c mthg calls 6 procedures: chmthg, feas, gha, ghbcd, ghx and trin. +c +c the program is completely self-contained and communication to it is +c achieved solely through the parameter list of mthg. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mthg needs +c 6 arrays ( c , dmyr1 , dmyr2 , dmyr3 , dmyr4 and dmyr5 ) of +c length at least jdimr ; +c 7 arrays ( xstar , best , dmyc1 , dmyc2 , dmyc3 , dmyc4 and +c dmycr1 ) of length at least jdimc ; +c 3 arrays ( p , w and a ) of length at least jdimr x jdimc . +c +c the arrays are currently dimensioned to allow problems for which +c m .le. 50 , +c n .le. 500 +c (so, in the calling program, arrays p and w must be dimensioned +c at (50,500) ). changing such limits necessitates changing the +c dimension of all the arrays in subroutine mthg, as well as the first +c two executable statements. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c n = number of items; +c m = number of knapsacks; +c p(i,j) = profit of item j if assigned to knapsack i +c (i=1,...,m; j=1,...,n); +c w(i,j) = weight of item j if assigned to knapsack i +c (i=1,...,m; j=1,...,n); +c c(i) = capacity of knapsack i (i=1,...,m); +c minmax = 1 if the objective function must be minimized, +c = 2 if the objective function must be maximized; +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c z = value of the solution found if z .gt. 0 , +c = 0 if no feasible solution is found, +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c xstar(j) = knapsack where item j is inserted in the solution found. +c +c all the parameters are integer. on return of mthg all the input +c parameters are unchanged, but p(i,j) is set to 0 for all pairs +c (i,j) such that w(i,j) .gt. c(i) . +c + integer p(50,500),w(50,500),c(50),xstar(500),z + integer zm + integer best(500) + integer a(50,500) + integer dmyr1(50),dmyr2(50),dmyr3(50),dmyr4(50),dmyr5(50) + integer dmyc1(500),dmyc2(500),dmyc3(500),dmyc4(500) + real dmycr1(500) +c +c Definition of the internal parameters. +c + jdimr = 50 + jdimc = 500 + z = 0 + if ( jck .eq. 1 ) call chmthg(n,m,p,w,c,jdimr,jdimc,z) + if ( z .lt. 0 ) return +c +c Initialize. +c + invst = 0 + imult = - 1 + if ( minmax .eq. 2 ) go to 10 +c +c Transform the minimization problem into a maximization problem. +c + call trin(p,n,m,invst,lam,jdimr,jdimc) + imult = 1 +c +c Solve the maximization problem. +c +c Check for infeasibility. +c + 10 call feas(n,m,p,w,c,xstar,jfi,jdimr,jdimc) + if ( jfi .eq. 1 ) go to 30 +c +c First heuristic solution. +c + call gha(p,w,c,n,m,z,xstar,iub,best,kvst,inf, + & jdimr,jdimc,dmyr1,dmyr2,dmyc1,dmyc2,dmyc3,dmyc4) + if ( z .eq. iub ) go to 20 +c +c Second heuristic solution. +c + call ghbcd(p,w,c,n,m,z,xstar,inf, + & jdimr,jdimc,dmyc1,dmyr1,dmyr2,dmyr3,dmyr4,dmyr5, + & dmyc2,dmyc3,dmyc4,dmycr1,a) +c +c Terminate. +c + 20 zm = z + z = 0 + if ( zm .gt. kvst ) z = invst - zm*imult + 30 if ( minmax .eq. 2 ) return +c +c Restore the original minimization problem. +c + do i=1,m + do j=1,n + if ( p(i,j) .gt. 0 ) p(i,j) = lam - p(i,j) + end do + end do + + return + end + subroutine mthm ( n, m, p, w, c, z, x, jdn, jdm, li, jck, cr, + & min, xx, x1, f ) + +c*********************************************************************72 +c +cc MTHM heuristically solves the 0-1 multiple knapsack problem. +c +c maximize z = p(1)*(y(1,1) + ... + y(m,1)) + +c ... + +c p(n)*(y(1,n) + ... + y(m,n)) +c subject to: +c +c w(1)*y(i,1) + ... + w(n)*y(i,n) .le. c(i) for i=1,...,m, +c y(1,j) + ... + y(m,j) .le. 1 for j=1,...,n, +c y(i,j) = 0 or 1 for i=1,...,m, j=1,...,n. +c +c the program is included in the volume +c s. martello, p. toth, "knapsack problems: algorithms +c and computer implementations", john wiley, 1990 +c and implements the polynomial-time algorithms described +c in section 6.6.2 . +c the program derives from an earlier code presented in +c s. martello, p. toth, "heuristic algorithms for the +c multiple knapsack problem", computing, 1981. +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdn - 1 and 1 .le. m .le. jdm - 1 ; +c 2) p(j), w(j) and c(i) positive integers; +c 3) min (c(i)) .ge. min (w(j)); +c 4) max (w(j)) .le. max (c(i)); +c 5) max (c(i)) .lt. w(1) + ... + w(n); +c 6) p(j)/w(j) .ge. p(j+1)/w(j+1) for j=1,...,n-1; +c 7) c(i) .le. c(i+1) for i=1,...,m-1. +c +c mthm can call 6 subroutines: +c chmthm to check the input data; +c mgr1 or mgr2 to find an initial feasible solution; +c rearr to re-arrange a feasible solution; +c impr1 and impr2 to improve on a feasible solution. +c the user selects the sequence of calls through input parameters. +c +c the program is completely self-contained and communication to it +c is achieved solely through the parameter list of mthm. +c the only machine-dependent constant is used to define inf (first +c executable statement), which must be set to a large positive +c integer value. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mthm needs +c 6 arrays ( p , w , x , min , xx and x1 ) of length at +c least jdn ; +c 2 arrays ( c and cr ) of length at least jdm ; +c 1 array ( f ) of length at least jdm x jdm . +c in addition, subroutine mgr2 uses +c 7 arrays of length 5 ; +c 1 array of length 201 ; +c 1 array of length 5 * 200 ; +c subroutine mgr2 is called only when m .le. 5 and n .le. 200 . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c n = number of items; +c m = number of knapsacks; +c p(j) = profit of item j (j=1,...,n); +c w(j) = weight of item j (j=1,...,n); +c c(i) = capacity of knapsack i (i=1,...,m); +c jdn = dimension of arrays p , w , x , min , xx and x1 ; +c jdm = dimension of arrays c , cr and f ; +c li = 0 to output the initial feasible solution, +c = 1 to also perform subroutines rearr and impr1, +c = 2 to also perform subroutines rearr, impr1 and impr2; +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c z = value of the solution found if z .gt. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : +c condition -z is violated; +c x(j) = 0 if item j is not in the solution found +c (i.e. if y(i,j) = 0 for all i ), +c = knapsack where item j is inserted, otherwise +c (i.e. if y(x(j),j) = 1 ). +c +c arrays cr, min, xx, x1 and f are dummy. +c +c all the parameters are integer. on return of mthm all the +c input parameters are unchanged. +c +cf2py intent(in) n, m, p, w, c, jdn, jdm, li, jck +cf2py intent(hide) cr, min, xx, x1, f +cf2py intent(out) z, x +Cf2py depend(jdn) p, w, x, min, xx, x1 +Cf2py depend(jdm) c, cr, f + integer p(jdn),w(jdn),x(jdn),c(jdm),z + integer min(jdn),xx(jdn),x1(jdn),cr(jdm),f(jdm,jdm),z1 + + inf = 999999999 + z = 0 + if ( jck .eq. 1 ) call chmthm(n,m,p,w,c,jdn,jdm,z) + if ( z .lt. 0 ) return + if ( m .le. 5 .and. n .le. 200 ) go to 10 + call mgr1(n,p,w,m,c,z,x,cr,inf,jdn,jdm) + go to 20 + + 10 continue + + call mgr2(n,p,w,m,c,z,x,cr,inf,jdn,jdm) + + 20 continue + + if ( li .eq. 0 ) go to 60 + + z1 = z + do j=1,n + x1(j) = x(j) + end do + + call rearr(n,p,w,m,c,z,x,cr,inf,jdn,jdm) + + call impr1(n,p,w,m,z,x,cr,inf,jdn,jdm,f) + + if ( li .ne. 1 ) then + + call impr2(n,p,w,m,z,x,cr,min,xx,inf,jdn,jdm) + + end if + + if ( z .lt. z1 ) then + + z = z1 + + do j=1,n + x(j) = x1(j) + end do + + end if + + 60 continue + + do j=1,n + if ( x(j) .gt. m ) x(j) = 0 + end do + + return + end + subroutine mtm ( n, m, p, w, c, z, x, back, jck, jub ) + +c*********************************************************************72 +c +cc MTM solves the 0-1 multiple knapsack problem. +c +c Discussion: +c +c The 0-1 multiple knapsack problem is: +c +c maximize z = p(1)*(y(1,1) + ... + y(m,1)) + +c ... + +c p(n)*(y(1,n) + ... + y(m,n)) +c subject to: +c +c w(1)*y(i,1) + ... + w(n)*y(i,n) .le. c(i) for i=1,...,m, +c y(1,j) + ... + y(m,j) .le. 1 for j=1,...,n, +c y(i,j) = 0 or 1 for i=1,...,m, j=1,...,n. +c +c the program is included in the volume +c s. martello, p. toth, "knapsack problems: algorithms +c and computer implementations", john wiley, 1990 +c and implements the enumerative algorithm described in +c section 6.4.3. +c +c the program derives from an earlier code presented in +c s. martello, p. toth, "algorithm 632. a program for the 0-1 +c multiple knapsack problem", acm transactions on mathematical +c software, 1985. +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. maxn and 1 .le. m .le. maxm , where maxn and +c maxm are defined by the first two executable statements; +c 2) p(j), w(j) and c(i) positive integers; +c 3) min (c(i)) .ge. min (w(j)); +c 4) max (w(j)) .le. max (c(i)); +c 5) max (c(i)) .lt. w(1) + ... + w(n) ; +c 6) p(j)/w(j) .ge. p(j+1)/w(j+1) for j=1,...,n-1; +c 7) c(i) .le. c(i+1) for i=1,...,m-1. +c +c mtm calls 5 procedures: chmtm, par, pi, sigma and skp2. +c +c the program is completely self-contained and communication to it +c is achieved solely through the parameter list of mtm. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mtm needs +c 5 arrays ( c , f , pbl , q and v ) of length at least m ; +c 8 arrays ( p , w , x , ubb , bs , xs , lx and lxi ) of +c length at least n ; +c 3 arrays ( b , ps and ws ) of length at least n + 1 ; +c 3 arrays ( bb , xc and xl ) of length at least m x n ; +c 1 array ( bl ) of length at least m x (n + 1) ; +c 5 arrays ( d , min , pbar , wbar and zbar ) of length at +c least n (for internal use in subroutine skp2) . +c +c the arrays are currently dimensioned to allow problems for which +c m .le. 10 and n .le. 1000 . changing such dimensions also requires +c changing the dimensions of bs , ps , ws , xs , lx and lxi +c in subroutine sigma, of bb , bl , xl , bs , ps , ws and xs +c in subroutine pi, of bb , lx and lxi in subroutine par, of d , +c min , pbar , wbar and zbar in subroutine skp2. in addition, the +c values of maxn and maxm must be conveniently defined. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c +c n = number of items; +c +c m = number of knapsacks; +c +c p(j) = profit of item j (j=1,...,n); +c +c w(j) = weight of item j (j=1,...,n); +c +c c(i) = capacity of knapsack i (i=1,...,m); +c +c back = -1 if exact solution is required, +c = maximum number of backtrackings to be performed, if +c heuristic solution is required; +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c +c z = value of the solution found if z .gt. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : +c condition -z is violated; +c x(j) = 0 if item j is not in the solution found, +c (i.e. if y(i,j) = 0 for all i ), +c = knapsack where item j is inserted, otherwise +c (i.e. if y(x(j),j) = 1 ); +c jub = upper bound on the optimal solution value (to evaluate +c z when back .gt.0 ). +c +c all the parameters are integer. on return of mtm all the +c input parameters are unchanged except back , which gives +c the number of backtrackings performed. +c +c meaning of the main internal variables: +c +c i = knapsack currently considered. +c +c lb = lower bound on the optimal solution. +c +c ub = upper bound on the optimal solution. +c +c vb = value of the current solution. +c +c xc(i,j) = 1 if item j is inserted in knapsack i in +c the current solution. +c = 0 otherwise. +c +c f(i) = pointer to the last item inserted in knapsack i +c ( = -1 if knapsack i is empty). +c +c bb(i,j) = pointer to the item inserted in knapsack i +c just before item j ( = -1 if j is the first +c item inserted in knapsack i ). +c +c q(i) = current available capacity of knapsack i . +c +c b(j) = 1 if item j is not inserted in any knapsack. +c = 0 if item j is inserted in a knapsack. +c +c pbl(i) = number of the items which can be inserted in +c knapsack i . +c +c bl(i,s) = pointer to the s-th item which can be inserted +c in knapsack i . +c +c xl(i,j) = 1 if item j was inserted in knapsack i in +c the last execution of subroutine pi. +c = 0 otherwise. +c +cf2py intent(in) n, m, p, w, c, jck, back +cf2py intent(hide) jub +cf2py intent(out) z, x, back + integer p(1000),w(1000),c(10),x(1000),back,z + integer bb(10,1000),bl(10,1001),xc(10,1000),xl(10,1000) + integer b(1001),ubb(1000) + integer f(10),pbl(10),q(10),v(10),s,u,ub,vb + integer bs,ps,ws,xs + + common /sngl/ bs(1000),ps(1001),ws(1001),xs(1000) + common /pub/ lx(1000),lxi(1000),lr,lri,lubi + + maxn = 1000 + maxm = 10 + z = 0 + + if ( jck .eq. 1 ) then + call chmtm(n,m,p,w,c,maxn,maxm,z) + end if + + if ( z .lt. 0 ) then + return + end if + + if ( m .eq. 1 ) go to 230 +c +c step 1 (initialization). +c + jback = back + back = 0 + kub = 0 + n1 = n + 1 + b(n1) = 1 + m1 = m - 1 + + do j=1,n + b(j) = 1 + do i=1,m + xc(i,j) = 0 + bb(i,j) = 0 + end do + end do + + do i=1,m1 + q(i) = c(i) + f(i) = -1 + end do + + q(m) = c(m) + z = 0 + vb = 0 + i = 1 + call sigma(n,m,p,w,c,1,b,kub,ub) + jub = ub + do j=1,n + lxi(j) = lx(j) + end do + lri = lr + lubi = ub + iflag = 0 +c +c step 2 (heuristic). +c + 50 continue + + kub = z - vb + call pi(n,m,p,w,q,i,b,bb,kub,bl,lb,pbl,v,xl) + if ( lb + vb .le. z ) go to 120 + z = lb + vb + + do j=1,n + x(j) = 0 + do s=1,i + if ( xc(s,j) .ne. 0 ) then + x(j) = s + go to 65 + end if + end do +65 continue + end do + + ip = pbl(i) + + do j=1,ip + jj = bl(i,j) + if ( xl(i,j) .eq. 1 ) x(jj) = i + end do + + i1 = i + 1 + do ii=i1,m + ip = pbl(ii) + do j=1,ip + jj = bl(ii,j) + if ( xl(ii,j) .eq. 1 ) x(jj) = ii + end do + end do + + if ( jback .eq. 1 ) then + return + end if + + if ( ub .eq. lb ) go to 180 +c +c step 3 (updating). +c + 120 if ( v(i) .eq. 0 ) go to 160 + iuv = ub + vb + u = pbl(i) + ibv = 0 + do 150 s=1,u + if ( xl(i,s) .eq. 0 ) go to 150 + j = bl(i,s) + xc(i,j) = 1 + q(i) = q(i) - w(j) + vb = vb + p(j) + b(j) = 0 + bb(i,j) = f(i) + ubb(j) = iuv + + if ( iflag .ne. 1 ) then + lub = iuv + lj = j + li = i + end if + + f(i) = j + ibv = ibv + p(j) + if ( ibv .eq. v(i) ) go to 160 + call par(i,i,ub,iflag,vb,lub,lj,li,f,bb,q,b,n) + if ( iflag .eq. 1 ) go to 140 + kub = z - vb + call sigma(n,m,p,w,q,i,b,kub,ub) + lj = n1 + 140 iuv = ub + vb + if ( iuv .le. z ) go to 180 + 150 continue + + 160 if ( i .eq. m - 1 ) go to 180 + ip1 = i + 1 + call par(ip1,i,ub,iflag,vb,lub,lj,li,f,bb,q,b,n) + if ( iflag .eq. 1 ) go to 170 + kub = z - vb + call sigma(n,m,p,w,q,ip1,b,kub,ub) + lj = n1 + 170 if ( ub + vb .le. z ) go to 180 + i = i + 1 + go to 120 +c +c step 4 (backtracking). +c + 180 continue + + if ( i .le. 0 ) then + back = back - 1 + return + end if + + 190 if ( back .eq. jback ) return + back = back + 1 + if ( f(i) .ne. (-1) ) go to 210 + + do j=1,n + bb(i,j) = 0 + end do + + i = i - 1 + go to 180 + + 210 continue + + j = f(i) + xc(i,j) = 0 + b(j) = 1 + vb = vb - p(j) + q(i) = q(i) + w(j) + do s=1,n + if ( bb(i,s) .eq. j ) bb(i,s) = 0 + end do + f(i) = bb(i,j) + if ( ubb(j) .le. z ) go to 180 + ub = ubb(j) - vb + iflag = 1 + go to 50 +c +c Particular case ( 0-1 single knapsack problem). +c + 230 continue + + k1 = c(1) + call skp2 ( n, p, w, k1, 0, x, z ) + back = 0 + return + end + subroutine mtp ( n, w, c, z, xstar, jdim, back, jck, lb, wr, + & xstarr, dum, res, rel, x, r, wa, wb, kfix, fixit, xred, ls, + & lsb, xheu ) + +c*********************************************************************72 +c +cc MTP solves the bin packing problem +c +c minimize z = y(1) + ... + y(n) +c +c subject to: +c +c w(1)*x(i,1) + ... + w(n)*x(i,n) .le. c*y(i) for i=1,...,n, +c x(1,j) + ... + x(m,j) = 1 for j=1,...,n, +c y(i) = 0 or 1 for i=1,...,n, +c x(i,j) = 0 or 1 for i=1,...,n, j=1,...,n +c +c (i.e., minimize the number of bins of capacity c needed to allocate +c n items of size w(1),...,w(n) ). +c +c the program is included in the volume +c s. martello, p. toth, "knapsack problems: algorithms +c and computer implementations", john wiley, 1990 +c and implements the branch-and-bound algorithm described +c in section 8.5 . +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdim; +c 2) w(j) and c positive integers; +c 3) w(j) .le. c for j=1,..., n; +c 4) w(j) .ge. w(j+1) for j=1,...,n-1. +c +c in the output solution (see below) the z lowest indexed bins are +c used. +c +c mtp calls 14 procedures: chmtp, enumer, ffdls, fixred, hbfds, +c insert, lcl2, l2, l3, mwfds, restor, +c search, sorti2 and update. +c +c the program is completely self-contained and communication to it is +c achieved solely through the parameter list of mtp. +c no machine-dependent constant is used . +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mtp needs 17 arrays ( w , xstar , wr, xstarr , dum , res , +c rel , x , r , wa , wb , kfix , fixit , +c xred , ls , lsb and xheu ) of length +c at least jdim . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c +c n = number of items; +c +c w(j) = weight of item j; +c +c c = capacity of the bins; +c +c jdim = dimension of the 17 arrays; +c +c back = - 1 if exact solution is required, +c = maximum number of backtrackings to be performed, +c if heuristic solution is required; +c +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c +c z = value of the solution found if z .gt. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c +c xstar(j) = bin where item j is inserted in the solution found; +c +c lb = lower bound on the optimal solution value. +c +c all the arrays except w and xstar are dummy. +c +c all the parameters are integer. on return of mtp all the input +c parameters are unchanged except back , which gives the number of +c backtrackings performed. +c + integer w(jdim) + integer xstar(jdim),c,z,back + integer wr(jdim),xstarr(jdim),dum(jdim),vstar + integer res(jdim),rel(jdim),x(jdim),r(jdim),wa(jdim),wb(jdim), + & kfix(jdim),fixit(jdim),xred(jdim),ls(jdim),lsb(jdim), + & xheu(jdim) + + z = 0 + if ( jck .eq. 1 ) call chmtp(n,w,c,jdim,z) + if ( z .lt. 0 ) return + lbstar = 0 + nn = 9*n/10 + if ( w(1) + w(nn) .ge. c ) go to 40 +c +c try a quick solution. +c +c heuristic. +c + call ffdls(n,w,c,z,r,xstar,ls,lsb,jdim) +c +c lower bound l1. +c + isumr = 0 + do j=1,z + isumr = isumr + r(j) + end do + isum = z*c - isumr + lbstar = (isum - 1)/c + 1 + if ( lbstar .eq. z ) go to 70 +c +c improved lower bound. +c + iss = 0 + + do i=1,n + if ( w(i) + w(n) .le. c ) go to 30 + iss = iss + w(i) + end do + go to 70 + 30 iss = isum - iss + lbstar = i - 1 + (iss - 1)/c + 1 + if ( lbstar .eq. z ) go to 70 +c +c lower bound l2. +c + call l2(n,w,c,lbal,jdim) + if ( lbal .le. lbstar ) go to 60 + lbstar = lbal + if ( lbstar .eq. z ) go to 70 + go to 60 +c +c regular solution. +c +c lower bound l3 and reduction. +c + 40 isum = 0 + do i=1,n + isum = isum + w(i) + end do + 60 z = 0 + call l3(n,w,c,0,m,dum,xstar,nf,lb3,n+1,xstarr,isum,z, + & res,rel,jdim) + if ( lb3 .gt. lbstar ) lbstar = lb3 + if ( nf .gt. 0 ) go to 80 + 70 back = 0 + lb = lbstar + return + 80 if ( nf .eq. n ) go to 100 +c +c define the reduced problem. +c + ii = 0 + + do i=1,n + if ( xstar(i) .le. 0 ) then + ii = ii + 1 + wr(ii) = w(i) + xstarr(ii) = xstarr(i) - m + end if + end do + + go to 120 + 100 do i=1,n + wr(i) = w(i) + end do + 120 vstar = z - m + lb = lbstar - m +c +c branch-and-bound. +c + call enumer(nf,wr,c,xstarr,vstar,lb,back, + & x,r,wa,wb,kfix,fixit,xred,ls,lsb,dum,xheu, + & res,rel,jdim) +c +c re-build the solution. +c + z = vstar + m + lb = lb + m + ii = 0 + + do i=1,n + if ( xstar(i) .le. 0 ) then + ii = ii + 1 + xstar(i) = xstarr(ii) + m + end if + end do + + return + end + subroutine mts(n,w,c,z,x,m2,pers,jdd,itm,xx,ws,zs,sum, + & td1,td2,td3) + +c*********************************************************************72 +c +cc MTS solves a small subset sum problem. +c +c jvbit must be dimensioned at 31 . +c arrays td1 , td2 and td3 are used for the dynamic programming +c lists. their dimension jdd can be changed according to the number +c of states wanted for the lists (in this case the value of jdd , +c used for adjustable dimensions, must be changed). +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(itm),x(itm),c,z + integer xx(itm),ws(itm),zs(itm),sum(itm) + integer td1(jdd,2),td2(jdd,2),td3(jdd,2) + integer jvbit(31) + integer v,cf,cs,cd +c +c initialize. +c + cf = c + cs = c +c +c dynamic programming. +c + cd = c + call dinsm(n,w,cd,m2,jdd,td1,td2,td3,nsds,nsdm,m,jflm,jfls,pers) + jxpack = 0 + if ( jfls .eq. 2 ) go to 10 + if ( jfls .eq. 3 ) go to 20 + call usedin(c,td1,jdd,nsds,loc1) + jts = td1(loc1,1) + go to 30 + 10 call usedin(c,td2,jdd,nsds,loc1) + jts = td2(loc1,1) + go to 30 + 20 call usedin(c,td3,jdd,nsds,loc1) + jts = td3(loc1,1) + 30 if ( jflm .eq. 2 ) go to 40 + call usedin(c,td1,jdd,nsdm,loc2) + jtm = td1(loc2,1) + jtml = td1(nsdm,1) + go to 50 + 40 call usedin(c,td2,jdd,nsdm,loc2) + jtm = td2(loc2,1) + jtml = td2(nsdm,1) + 50 nold = n + nold1 = nold + 1 + n = n - m + jwnold = w(n+1) +c +c optimal initial solution. +c + loc = loc1 + jsol = jts + if ( jsol .ge. jtm ) go to 60 + loc = - loc2 + jsol = jtm + 60 call upstar(0,0,n,xx,jsol,loc,x,z,lstar) + if ( z .eq. c ) go to 470 + if ( n .eq. 0 ) go to 470 + w(n+1) = c + 1 + lim = cf + minw = w(n) + cs = c + do l=1,n + ll = l + if ( w(l) .gt. cs ) go to 80 + cs = cs - w(l) + end do + ll = n + 1 + 80 ll = ll - 1 + if ( cs .gt. 0 ) go to 90 + call upstar(0,ll,n,xx,c,-1,x,z,lstar) + go to 470 + 90 continue + jvbit(1) = 1 + if ( m2 .le. 1 ) go to 110 + jbit = 1 + do j=2,m2 + jbit = jbit*2 + jvbit(j) = jbit + end do + 110 jsum = jtml + do j=1,n + jj = n - j + 1 + jsum = jsum + w(jj) + sum(jj) = jsum + end do + do j=1,n + xx(j) = 0 + end do + lold = n + ns = nold - m2 + ii = 1 + go to 180 +c +c try to insert the ii-th item into the current solution. +c + 140 if ( w(ii) .le. c ) go to 150 + ii = ii + 1 + go to 140 +c +c build a new current solution. +c + 150 if ( (cf - c) + sum(ii) .le. z ) go to 440 + cs = c - ws(ii) + in = zs(ii) + ll = n + if ( in .gt. n ) go to 180 + do 160 l=in,n + ll = l + if ( w(l) .gt. cs ) go to 170 + cs = cs - w(l) + 160 continue + go to 180 +c +c update the optimal solution. +c + 170 ll = ll - 1 + if ( cs .ne. 0 ) go to 180 + call upstar(ii-1,ll,n,xx,cf,-1,x,z,lstar) + if ( z .ne. lim ) go to 440 + go to 470 +c +c save the current solution. +c + 180 ws(ii) = c - cs + zs(ii) = ll + 1 + xx(ii) = 1 + noldii = nold1 - ii + if ( ii .gt. ns ) jxpack = jxpack + jvbit(noldii) + nn = ll - 1 + + do j=ii,nn + j1 = j + 1 + ws(j1) = ws(j) - w(j) + zs(j1) = ll + 1 + xx(j1) = 1 + noldj1 = nold1 - j1 + if ( j1 .gt. ns ) jxpack = jxpack + jvbit(noldj1) + end do + + 200 j1 = ll + 1 + + do j=j1,lold + ws(j) = 0 + zs(j) = j + end do + 220 lold = ll + c = cs + if ( jfls .eq. 2 ) go to 230 + if ( jfls .eq. 3 ) go to 240 + call usedin(c,td1,jdd,nsds,loc) + jts1 = td1(loc,1) + go to 250 + 230 call usedin(c,td2,jdd,nsds,loc) + jts1 = td2(loc,1) + go to 250 + 240 call usedin(c,td3,jdd,nsds,loc) + jts1 = td3(loc,1) + 250 if ( c .le. cd ) go to 280 + if ( jflm .eq. 2 ) go to 260 + call usedin(c,td1,jdd,nsdm,loc1) + jtm = td1(loc1,1) + go to 270 + 260 call usedin(c,td2,jdd,nsdm,loc1) + jtm = td2(loc1,1) + 270 if ( jts1 .ge. jtm ) go to 280 + newsol = (cf - c) + jtm + loc = - loc1 + go to 350 + 280 newsol = (cf - c) + jts1 + if ( ll .lt. ns ) go to 350 +c +c the next item ( ll + 1 ) is one of the last m2 . +c + 290 if ( jfls .eq. 2 ) go to 300 + if ( jfls .eq. 3 ) go to 310 + jts1 = td1(loc,1) + jts2 = td1(loc,2) + go to 320 + 300 jts1 = td2(loc,1) + jts2 = td2(loc,2) + go to 320 + 310 jts1 = td3(loc,1) + jts2 = td3(loc,2) + 320 if ( iand ( jxpack, jts2 ) .eq. 0 ) go to 330 + loc = loc - 1 + go to 290 + 330 newsol = (cf - c) + jts1 + if ( c .gt. cd ) go to 350 +c +c no more forward steps are required. +c + ii = ll + 1 + if ( newsol .le. z ) go to 340 + call upstar(ll,ll,n,xx,newsol,loc,x,z,lstar) + if ( z .eq. lim ) go to 470 + 340 if ( ll .lt. n ) go to 440 + go to 410 +c +c the next item is one of the first ns or c .gt. cd . +c + 350 if ( newsol .le. z ) go to 360 + call upstar(ll,ll,n,xx,newsol,loc,x,z,lstar) + if ( z .eq. lim ) go to 470 + 360 if ( ll .ge. n - 2 ) go to 370 + ii = ll + 2 + if ( c .ge. minw ) go to 140 + go to 440 +c +c ll .ge. n - 2 . +c + 370 ii = n + if ( ll .eq. n - 1 ) go to 440 + if ( ll .eq. n ) go to 410 +c +c ll = n - 2 . +c + if ( c .lt. w(n) ) go to 440 + c = c - w(n) + xx(n) = 1 + if ( jflm .eq. 2 ) go to 380 + call usedin(c,td1,jdd,nsdm,loc) + jtm = td1(loc,1) + go to 390 + 380 call usedin(c,td2,jdd,nsdm,loc) + jtm = td2(loc,1) + 390 v = cf - c + jtm + if ( z .ge. v ) go to 400 + call upstar(n,n,n,xx,v,-loc,x,z,lstar) + if ( z .eq. lim ) go to 470 + 400 c = c + w(n) + xx(n) = 0 + go to 440 +c +c particular backtracking for xx(n) = 1 . +c + 410 xx(n) = 0 + noldn = nold1 - n + if ( n .gt. ns ) jxpack = jxpack - jvbit(noldn) + c = c + w(n) + v = cf - c + if ( jflm .eq. 2 ) go to 420 + call usedin(c,td1,jdd,nsdm,loc) + jtm = td1(loc,1) + go to 430 + 420 call usedin(c,td2,jdd,nsdm,loc) + jtm = td2(loc,1) + 430 v = v + jtm + if ( z .ge. v ) go to 440 + call upstar(n,n,n,xx,v,-loc,x,z,lstar) + if ( z .eq. lim ) go to 470 +c +c backtrack. +c + 440 nn = ii - 1 + if ( nn .eq. 0 ) go to 470 + do 450 jj=1,nn + kk = ii - jj + if ( xx(kk) .eq. 1 ) go to 460 + 450 continue + go to 470 + 460 c = c + w(kk) + xx(kk) = 0 + noldkk = nold1 - kk + if ( kk .gt. ns ) jxpack = jxpack - jvbit(noldkk) + ii = kk + 1 + go to 140 +c +c return. +c + 470 w(n+1) = jwnold + n = nold + c = cf + i = n + if ( lstar .lt. 0 ) go to 530 + if ( jfls .eq. 2 ) go to 480 + if ( jfls .eq. 3 ) go to 490 + jts = td1(lstar,2) + go to 500 + 480 jts = td2(lstar,2) + go to 500 + 490 jts = td3(lstar,2) + 500 ll = jts + ii = n - m + 510 if ( ii .eq. 0 ) go to 520 + if ( x(ii) .eq. 1 ) go to 520 + ii = ii - 1 + go to 510 + 520 jj = n - ii + if ( jj .gt. m2 ) jj = m2 + go to 560 + 530 mlstar = - lstar + if ( jflm .eq. 2 ) go to 540 + jtm = td1(mlstar,2) + go to 550 + 540 jtm = td2(mlstar,2) + 550 ll = jtm + jj = m + 560 do 570 j=1,jj + l = ll/2 + x(i) = ll - l*2 + ll = l + i = i - 1 + 570 continue + return + end + subroutine mtsl ( n, w, c, z, x, jdn, jdd, itmm, jck, wo, ind, + & xx, ws, zs, sum, td1, td2, td3 ) + +c*********************************************************************72 +c +cc MTSL solves the subset-sum problem +c +c maximize z = w(1)*x(1) + ... + w(n)*x(n) +c +c subject to: w(1)*x(1) + ... + w(n)*x(n) .le. c , +c x(j) = 0 or 1 for j=1,...,n. +c +c the program implements the mixed algorithm described in +c section 4.2.3 . +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdn - 1 ; +c 2) w(j), c positive integers; +c 3) max (w(j)) .lt. c ; +c 4) w(1) + ... + w(n) .gt. c . +c +c mtsl calls 8 procedures: chmtsl, dinsm, mts, presp, sorti, tab, +c upstar and usedin. +c if not present in the library of the host, the user must supply an +c integer function iand(i1,i2) which sets iand to the bit-by-bit +c logical and of i1 and i2 . +c +c communication to the program is achieved solely through the +c parameter list of mtsl. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mtsl needs +c 2 arrays ( w and x ) of length at least jdn ; +c 6 arrays ( wo , ind , xx , ws , zs and sum ) of length +c at least itmm ; +c 3 arrays ( td1 , td2 and td3 ) of length at least jdd x 2 . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c +c n = number of items; +c +c w(j) = weight of item j (j=1,...,n); +c +c c = capacity; +c +c jdn = dimension of arrays w and x ; jdn must be at least n + 1. +c +c jdd = maximum length of the dynamic programming lists (suggested +c value jdd = 5000); +c +c itmm = (maximum number of items in the core problem) + 1 ; +c itmm = jdn in order to be sure that the optimal solution is +c found. itmm .lt. jdn (suggested value itmm = 91) produces +c an approximate solution which is almost always optimal (to +c check optimality, see whether z = c ); +c +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c +c z = value of the solution found if z .gt. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c +c x(j) = 1 if item j is in the solution found, +c = 0 otherwise. +c +c Local parameters: +c +c it = length of the initial core problem (suggested value it = 30); +c +c id = increment of the length of the core problem (suggested value +c id = 30); +c +c m2 = number of items to be used for the second dynamic programming +c list; it must be 2 .le. m2 .le. min(31,n-4) (suggested value +c m2 = min ( 2.5*alog10(max(w(j))) , 0.8*n ) ). m1 , the number +c of items to be used for the first dynamic programming list, is +c automatically determined by the program; +c +c pers = value used to determine c bar according to the formula given +c in section 4.2.2 (suggested value pers = 1.3). +c +c arrays wo, ind, xx, ws, zs, sum, td1, td2 and td3 are dummy. +c +c all the parameters are integer. on return of mtsl all the input +c parameters are unchanged. +c + integer w(jdn),x(jdn),c,z + integer wo(itmm),ind(itmm),xx(itmm),ws(itmm),zs(itmm),sum(itmm) + integer td1(jdd,2),td2(jdd,2),td3(jdd,2) + z = 0 + if ( jck .eq. 1 ) call chmtsl(n,w,c,z,jdn) + if ( z .lt. 0 ) return + if ( n .gt. 2 ) go to 20 +c +c case n = 2 . +c + if ( w(1) .lt. w(2) ) go to 10 + z = w(1) + x(1) = 1 + x(2) = 0 + return + 10 z = w(2) + x(1) = 0 + x(2) = 1 + return +c +c definition of parameters it and id (for the core problem). +c + 20 it = 30 + id = 30 + itm = itmm + if ( itm .gt. n ) itm = n + 1 + if ( it .gt. itm - 1 ) it = itm - 1 + itc = it + 30 itco = itc +c +c definition and sorting of the core problem. +c + call presp(n,w,c,itc,itco,ind,nc,ni,jsum) + call sorti(itc,w,ind,jdn) + do i=1,itc + indi = ind(i) + wo(i) = w(indi) + end do + rmaxw = wo(1) +c +c definition of parameters m2 and pers (for dynamic programming). +c + m2 = 2.5*alog10(rmaxw) + if ( float(m2) .gt. 0.8*float(itc) ) m2 = 0.8*float(itc) + if ( m2 .gt. itc - 4 ) m2 = itc - 4 + if ( m2 .lt. 2 ) m2 = 2 + pers = 1.3 + if ( jsum .eq. 0 ) go to 60 +c +c all the wo are in the solution of the core problem. +c + do i = 1, itc + x(i) = 1 + end do + nz = jsum + go to 90 + 60 if ( itc .gt. m2 ) go to 80 + nz = 0 + do i=1,itc + x(i) = 0 + end do + go to 90 + 80 call mts(itc,wo,nc,nz,x,m2,pers,jdd,itm,xx,ws,zs,sum, + & td1,td2,td3) + 90 if ( nz .eq. nc ) go to 100 + if ( itco .eq. itm - 1 ) go to 100 +c +c repeat. +c + itc = itco + id + if ( itc .gt. itm - 1 ) itc = itm - 1 + go to 30 +c +c final solution (optimal if z = c or itm - 1 .eq. n ). +c + 100 z = nz + c - nc + + do i=1,itc + wo(i) = x(i) + end do + + do i=1,ni + x(i) = 1 + end do + + nl = ni + 1 + do i=nl,n + x(i) = 0 + end do + + do i=1,itc + jj = ind(i) + x(jj) = wo(i) + end do + + return + end + subroutine mtu1(n,p,w,c,rn,z,x,jdim,jub,xx,min) + +c*********************************************************************72 +c +cc MTU1 solves the unbounded single knapsack problem +c +c maximize z = p(1)*x(1) + ... + p(n)*x(n) +c +c subject to: w(1)*x(1) + ... + w(n)*x(n) .le. c , +c x(j) .ge. 0 and integer for j=1,...,n. +c +c the program is based on the branch-and-bound algorithm presented in +c s. martello, p. toth, "branch and bound algorithms for the solution +c of the general unidimensional knapsack problem", in m. roubens, ed., +c "advances in operations research", north holland, 1977. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdim),w(jdim),c,z + integer xx(jdim),cws,cwf,diff,r,s,s1,s2,t,profit,ps + real x(jdim),min(jdim) +c +c step 1. +c + cwf = c + s1 = c/w(1) + s2 = (c - s1*w(1))/w(2) + ip = s1*p(1) + s2*p(2) + cws = c - s1*w(1) - s2*w(2) + + if ( cws .eq. 0 ) then + + z = ip + jub = z + x(1) = s1 + x(2) = s2 + do j=3,n + x(j) = 0 + end do + return + + end if + + mink = c + 1 + min(n) = mink + + do j=2,n + k = n + 2 - j + if ( w(k) .lt. mink ) mink = w(k) + min(k-1) = mink + end do + w(n+1) = c + 1 + p(n+1) = 0 + lim = ip + cws*p(3)/w(3) + if ( n .eq. 2 ) lim = float(ip) + float(cws)*rn + itrunc = (w(2) - cws + w(1) - 1)/w(1) + lim12 = ip + (cws + itrunc*w(1))*p(2)/w(2) - itrunc*p(1) + if ( lim12 .gt. lim ) lim = lim12 + jub = lim + z = 0 + xx(1) = s1 + xx(2) = s2 + + do j=3,n + xx(j) = 0 + end do + + profit = ip + c = cws + ii = 2 + go to 110 +c +c step 2. +c + 60 s = c/w(ii) + if ( s .gt. 0 ) go to 70 + if ( z .ge. profit + c*p(ii+1)/w(ii+1) ) go to 120 + ii = ii + 1 + go to 60 +c +c step 3. +c + 70 ps = profit + s*p(ii) + cws = c - s*w(ii) + if ( ( cws .eq. 0 ) .or. ( ii .eq. n ) ) go to 80 + if ( z .ge. ps + cws*p(ii+1)/w(ii+1) ) go to 150 + c = cws + profit = ps + xx(ii) = s + go to 110 + 80 if ( z .ge. ps ) go to 150 + z = ps + ii1 = ii - 1 + do j=1,ii1 + x(j) = xx(j) + end do + x(ii) = s + ii1 = ii + 1 + do j=ii1,n + x(j) = 0 + end do + if ( z .ne. lim ) go to 150 + c = cwf + return +c +c step 4. +c + 110 ii = ii + 1 + if ( c .ge. int(min(ii-1)) ) go to 60 +c +c step 5. +c + 120 if ( z .ge. profit ) go to 140 + z = profit + do j=1,n + x(j) = xx(j) + end do + if ( z .ne. lim ) go to 140 + c = cwf + return + 140 if ( xx(n) .eq. 0 ) go to 150 + c = c + xx(n)*w(n) + profit = profit - xx(n)*p(n) + xx(n) = 0 +c +c step 6. +c + 150 ib = ii - 1 + do j=1,ib + kk = ii - j + if ( xx(kk) .gt. 0 ) go to 170 + end do + c = cwf + return + 170 r = c + c = c + w(kk) + profit = profit - p(kk) + xx(kk) = xx(kk) - 1 + if ( z .lt. profit + c*p(kk + 1)/w(kk + 1) ) go to 180 + c = c + xx(kk)*w(kk) + profit = profit - xx(kk)*p(kk) + xx(kk) = 0 + ii = kk + 1 + go to 150 + 180 if ( r .lt. int(min(kk)) ) go to 190 + ii = kk + 1 + go to 60 + 190 nn = kk + 1 + ii = kk + 1 +c +c step 7. +c + 200 diff = w(nn) - w(kk) + if ( diff ) 210,260,220 + 210 t = r - diff + if ( t .lt. int(min(nn-1)) ) go to 260 + s = c/w(nn) + ii = nn + go to 70 + 220 if ( diff .gt. r ) go to 260 + if ( z .ge. profit + p(nn) ) go to 260 + z = profit + p(nn) + do 230 j=1,kk + x(j) = xx(j) + 230 continue + kk1 = kk + 1 + do j=kk1,n + x(j) = 0 + end do + x(nn) = 1 + if ( z .ne. lim ) go to 250 + c = cwf + return + 250 r = r - diff + kk = nn +c +c step 8. +c + 260 if ( z .ge. profit + c*p(nn+1)/w(nn+1) ) go to 150 + nn = nn + 1 + go to 200 + end + subroutine mtu2(n,p,w,c,z,x,jdim,jfo,jck,jub,po,wo,xo,rr,pp) + +c*********************************************************************72 +c +cc MTU2 solves the unbounded single knapsack problem +c +c maximize z = p(1)*x(1) + ... + p(n)*x(n) +c +c subject to: w(1)*x(1) + ... + w(n)*x(n) .le. c , +c x(j) .ge. 0 and integer for j=1,...,n. +c +c the program is included in the volume +c s. martello, p. toth, "knapsack problems: algorithms +c and computer implementations", john wiley, 1990 +c and implements the enumerative algorithm described in +c section 3.6.3 . +c +c the input problem must satisfy the conditions +c +c 1) 2 .le. n .le. jdim - 1 ; +c 2) p(j), w(j), c positive integers; +c 3) max (w(j)) .le. c . +c +c mtu2 calls 5 procedures: chmtu2, ksmall, mtu1, redu and sortr. +c ksmall calls 8 procedures: bld, bldf, blds1, detns1, detns2, +c forwd, mpsort and sort7. +c +c the program is completely self-contained and communication to it is +c achieved solely through the parameter list of mtu2. +c no machine-dependent constant is used. +c the program is written in 1967 american national standard fortran +c and is accepted by the pfort verifier (pfort is the portable +c subset of ansi defined by the association for computing machinery). +c the program has been tested on a digital vax 11/780 and an h.p. +c 9000/840. +c +c mtu2 needs 8 arrays ( p , w , x , po , wo , xo , rr and +c pp ) of length at least jdim . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c +c meaning of the input parameters: +c n = number of item types; +c p(j) = profit of each item of type j (j=1,...,n); +c w(j) = weight of each item of type j (j=1,...,n); +c c = capacity of the knapsack; +c jdim = dimension of the 8 arrays; +c jfo = 1 if optimal solution is required, +c = 0 if approximate solution is required; +c jck = 1 if check on the input data is desired, +c = 0 otherwise. +c +c meaning of the output parameters: +c z = value of the solution found if z .gt. 0 , +c = error in the input data (when jck=1) if z .lt. 0 : condi- +c tion - z is violated; +c x(j) = number of items of type j in the solution found; +c jub = upper bound on the optimal solution value (to evaluate z +c when jfo=0). +c +c arrays po, wo, xo, rr and pp are dummy. +c +c all the parameters but xo and rr are integer. on return of mtu2 +c all the input parameters are unchanged. +c + integer p(jdim),w(jdim),x(jdim),po(jdim),wo(jdim),pp(jdim),c,z + real rr(jdim),xo(jdim) + z = 0 + if ( jck .eq. 1 ) call chmtu2(n,p,w,c,z,jdim) + if ( z .lt. 0 ) return +c +c heuristic solution through the core problem. +c + kc = n + if ( n .le. 200 ) go to 180 + do j=1,n + rr(j) = float(p(j))/float(w(j)) + end do + kc = n/100 + if ( kc .lt. 100 ) kc = 100 + if ( jfo .eq. 0 ) kc = 100 + kk = n - kc + 1 + call ksmall(n,rr,kk,(n+5)/6,xo) + rk = rr(kk) + if = 0 + il = n + 1 + do 30 j=1,n + rr(j) = float(p(j))/float(w(j)) + if ( rr(j) .lt. rk ) go to 30 + if ( rr(j) .eq. rk ) go to 20 + if = if + 1 + pp(if) = j + go to 30 + 20 il = il - 1 + pp(il) = j + 30 continue + + if ( if .eq. 0 ) go to 50 + call sortr(if,rr,pp,jdim) + + do j=1,if + i = pp(j) + po(j) = p(i) + wo(j) = w(i) + w(i) = - w(i) + end do + + 50 if1 = if + 1 + + do j=if1,kc + i = pp(il) + po(j) = p(i) + wo(j) = w(i) + w(i) = - w(i) + pp(j) = i + il = il + 1 + end do + + jpk = po(kc) + jwk = wo(kc) +c +c reduction of the core problem. +c + call redu(kc,po,wo,jdim,jpx,x) + k = 0 + j = jpx + 70 k = k + 1 + po(k) = po(j) + wo(k) = wo(j) + pp(k) = pp(j) + j = x(j) + if ( j .gt. 0 ) go to 70 + if ( k .gt. 1 ) go to 80 + xo(1) = c/wo(1) + ixo1 = xo(1) + z = po(1)*ixo1 + jub = z + (c - wo(1)*ixo1)*jpk/jwk + po(2) = jpk + wo(2) = jwk + go to 90 +c +c solution of the reduced core problem. +c + 80 call mtu1(k,po,wo,c,rk,z,xo,jdim,jub,x,rr) + 90 if ( jfo .eq. 0 .or. z .eq. jub ) go to 140 + ip1 = po(1) + ip2 = po(2) + iw1 = wo(1) + iw2 = wo(2) + ip3 = po(3) + iw3 = wo(3) + if ( k .gt. 2 ) go to 100 + ip3 = ip2 + iw3 = iw2 + 100 do 130 j=1,n + x(j) = 0 + if ( w(j) .gt. 0 ) go to 110 + w(j) = - w(j) + go to 130 + 110 icr = c - w(j) + is1 = icr/iw1 + ib = p(j) + is1*ip1 + (icr - is1*iw1)*ip2/iw2 + if ( ib .le. z ) go to 130 + icrr = icr - is1*iw1 + is2 = icrr/iw2 + ip = p(j) + is1*ip1 + is2*ip2 + icws = icrr - is2*iw2 + ib = ip + icws*ip3/iw3 + itrunc = (iw2 - icws + iw1 - 1)/iw1 + lim12 = ip + (icws + itrunc*iw1)*ip2/iw2 - itrunc*ip1 + if ( lim12 .gt. ib ) ib = lim12 + if ( ib .le. z ) go to 130 + do jj=j,n + w(jj) = iabs(w(jj)) + end do + go to 180 + 130 continue + go to 160 + 140 do 150 j=1,n + x(j) = 0 + w(j) = iabs(w(j)) + 150 continue + 160 do j=1,k + i = pp(j) + x(i) = xo(j) + end do + jub = z + return +c +c solution through complete sorting. +c + 180 do j=1,kc + rr(j) = float(p(j))/float(w(j)) + end do + do j=1,n + pp(j) = j + end do + call sortr(n,rr,pp,jdim) + do j=1,n + i = pp(j) + po(j) = p(i) + wo(j) = w(i) + end do +c +c reduction of the problem. +c + call redu(n,po,wo,jdim,jpx,x) + kf = 0 + j = jpx + 220 kf = kf + 1 + po(kf) = po(j) + wo(kf) = wo(j) + pp(kf) = pp(j) + j = x(j) + if ( j .gt. 0 ) go to 220 + if ( kf .gt. 1 ) go to 230 + xo(1) = c/wo(1) + ixo1 = xo(1) + z = po(1)*ixo1 + jub = z + go to 240 + 230 call mtu1(kf,po,wo,c,0.,z,xo,jdim,jub,x,rr) + 240 do j=1,n + x(j) = 0 + end do + + do j=1,kf + i = pp(j) + x(i) = xo(j) + end do + + return + end + subroutine mwfds(n,w,c,m,kk,k,llb,x,jdim) + +c*********************************************************************72 +c +cc MWFDS performs a modified worst-fit decreasing heuristic. +c +c Discussion: +c +c For local use with current solution given. +c +c Time complexity o(n**2) . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdim),c,k(jdim),x(jdim),kk(jdim) + do j=1,m + k(j) = kk(j) + end do + i1 = 1 + if ( m .ge. llb ) go to 30 + m1 = m + 1 + i = 0 + do j=m1,llb + i = i + 1 + k(j) = c - w(i) + x(i) = j + end do + m = llb + i1 = i + 1 + if ( i1 .gt. n ) return + 30 do 60 i=i1,n +c +c insert the next item. +c + iwi = w(i) + maxres = - 1 + do 40 j=1,m + kres = k(j) - iwi + if ( kres .lt. 0 ) go to 40 + if ( kres .le. maxres ) go to 40 + maxres = kres + jm = j + 40 continue + if ( maxres .ge. 0 ) go to 50 +c +c initialize a new bin. +c + m = m + 1 + k(m) = c - iwi + x(i) = m + go to 60 +c +c insert the item into an old bin. +c + 50 k(jm) = k(jm) - iwi + x(i) = jm + 60 continue + + return + end + subroutine newb(c,val,minw0,ipn,iwn,fp1,fpn1,fw1,iubf0) + +c*********************************************************************72 +c +cc NEWB improves on the current upper bound. +c +c Discussion: +c +c The current bound is IUBF0. This routine improves the bound by +c taking into account the items following the core problem. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer c,val + + if ( c .ge. minw0 ) then + + ib = val + c*ipn/iwn + + else + + a = minw0 - c + ib = float(val) + fpn1 - a*fp1/fw1 + + end if + + iubf0 = max ( iubf0, ib ) + + return + end + subroutine par(i,ii,ub,iflag,vb,lub,lj,li,f,bb,q,b,n) + +c*********************************************************************72 +c +cc PAR does a parametric computation of the upper bounds. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer f(10),bb(10,1000),q(10),b(1001),ub,vb,r,s + common /pub/ lx(1000),lxi(1000),lr,lri,lubi + iflag = 0 + if ( b(lj) .ne. 0 ) go to 60 + i1 = i - 1 + if ( i1 .lt. li ) go to 20 + iq = 0 + do r=li,i1 + iq = iq + q(r) + end do + if ( iq .gt. lr ) return + 20 r = ii + s = f(r) + 30 if ( s .ne. (-1) ) go to 40 + r = r - 1 + s = f(r) + go to 30 + 40 if ( lx(s) .eq. 0 ) return + if ( s .eq. lj ) go to 50 + s = bb(r,s) + go to 30 + 50 ub = lub - vb + iflag = 1 + return + 60 i1 = i - 1 + if ( i1 .lt. 1 ) go to 80 + iq = 0 + do 70 r=1,i1 + iq = iq + q(r) + 70 continue + if ( iq .gt. lri ) return + 80 do 90 j=1,n + if ( b(j) .eq. 1 ) go to 90 + if ( lxi(j) .eq. 0 ) return + 90 continue + ub = lubi - vb + iflag = 1 + return + end + subroutine pen0(j,m,p,w,q,a,v,l1,pak,kap,pakl,ip,ir,il,if, + & penalt,jfo,jub,jz,inf,jdimr,jdimc,jnlev) + +c*********************************************************************72 +c +cc PEN0 computes the penalty for an item which was assigned to no knapsack. +c +c jfo = 1 iff item j can be inserted in only one knapsack. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),q(jdimr),a(jdimr,jdimc), + & v(jnlev,jdimr),pak(jdimr,jdimc),kap(jdimr,jdimc), + & pakl(jdimr),ip(jdimr),ir(jdimr),il(jdimr),if(jdimr) + integer penalt,pmin + pmin = inf + jfo = 0 + do 80 i=1,m + if ( a(i,j) .eq. (- 1) ) go to 80 + if ( w(i,j) .gt. q(i) ) go to 80 + jfo = jfo + 1 + jj = kap(i,j) + kl = il(i) + if ( jj .le. kl ) go to 70 + kr = ir(i) - w(i,j) + kp = ip(i) + p(i,j) + 10 if ( kr .ge. 0 ) go to 20 + jkl = pak(i,kl) + kr = kr + w(i,jkl) + kp = kp - p(i,jkl) + kl = kl - 1 + go to 10 + 20 krtot = q(i) - w(i,j) + w(i,j) = w(i,j) + inf + 30 kl = kl + 1 + if ( kl .le. pakl(i) ) go to 40 + rub = kp + go to 60 + 40 jkl = pak(i,kl) + if ( w(i,jkl) .gt. kr ) go to 50 + kr = kr - w(i,jkl) + kp = kp + p(i,jkl) + go to 30 + 50 if ( w(i,jkl) .gt. krtot ) go to 30 + rub = float(kp) + float(p(i,jkl)*kr)/float(w(i,jkl)) + 60 iub = rub + w(i,j) = w(i,j) - inf + lam = v(l1,i) - ( iub + if(i) ) + if ( lam .le. 0 ) go to 70 + if ( lam .lt. pmin ) pmin = lam + if ( jub - lam .le. jz ) jfo = jfo - 1 + go to 80 + 70 pmin = 0 + 80 continue + penalt = pmin + return + end + subroutine pen1(j,m,p,w,x,v,l1,pak,kap,pakl,ip,ir,il,if,penalt, + & jfo,jub,jz,jdimr,jdimc,jnlev) + +c*********************************************************************72 +c +cc PEN1 computes the penalty for an item assigned to more than one knapsack. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),x(jdimr,jdimc), + & v(jnlev,jdimr),pak(jdimr,jdimc),kap(jdimr,jdimc), + & pakl(jdimr),ip(jdimr),ir(jdimr),il(jdimr),if(jdimr) + integer penalt,psum,pmax + psum = 0 + pmax = 0 + jfo = 0 + do 80 i=1,m + if ( x(i,j) .eq. 0 ) go to 80 + jj = kap(i,j) + kl = il(i) + kp = ip(i) + kr = ir(i) + if ( jj - (kl + 1) ) 30,10,80 + 10 if ( kl + 1 .eq. pakl(i) ) go to 20 + jkl = pak(i,kl+2) + rub = float(kp) + float(p(i,jkl)*kr)/float(w(i,jkl)) + go to 70 + 20 rub = kp + go to 70 + 30 kp = kp - p(i,j) + kr = kr + w(i,j) + la = kl + 1 + l2 = pakl(i) + if ( la .le. l2 ) go to 40 + rub = kp + go to 70 + 40 do 50 jl=la,l2 + jj = pak(i,jl) + if ( w(i,jj) .gt. kr ) go to 60 + kr = kr - w(i,jj) + kp = kp + p(i,jj) + 50 continue + rub = kp + go to 70 + 60 rub = float(kp) + float(p(i,jj)*kr)/float(w(i,jj)) + 70 iub = rub + lam = v(l1,i) - (iub + if(i)) + if ( lam .le. 0 ) go to 80 + psum = psum + lam + if ( lam .gt. pmax ) pmax = lam + if ( jub - lam .le. jz ) jfo = i + 80 continue + penalt = psum - pmax + return + end + subroutine pi ( n, m, p, w, q, i, b, bb, kub, bl, lb, pbl, v, xl ) + +c*********************************************************************72 +c +cc PI computes a feasible solution to the current problem. +c +c Discussion: +c +c The solution is stored in array XL, the corresponding value in LB. +c +c Modified: +c +c 23 October 2013 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer bb(10,1000),bl(10,1001),xl(10,1000) + integer p(1000),w(1000),q(10),b(1001),pbl(10),v(10) + integer bs,pb,ps,qs,sb,u,ws,xs + + common /sngl/ bs(1000),ps(1001),ws(1001),xs(1000) +c +c step 1. +c + u = 0 + do j=1,n + if ( b(j) .ne. 0 ) then + u = u + 1 + bs(u) = j + end if + end do + + do j=i,m + pbl(j) = 0 + v(j) = 0 + end do + + lb = 0 + ikub = kub + if ( u .eq. 0 ) then + return + end if + + ns = 0 + sb = 0 + do j=1,u + jj = bs(j) + if ( bb(i,jj) .eq. 0 ) then + if ( w(jj) .le. q(i) ) then + ns = ns + 1 + sb = sb + w(jj) + bl(i,ns) = jj + ps(ns) = p(jj) + ws(ns) = w(jj) + end if + end if + end do + + ii = i +c +c step 2. +c + 40 continue + + pbl(ii) = ns + if ( sb .gt. q(ii) ) go to 60 + pb = 0 + if ( ns .eq. 0 ) go to 80 + do j=1,ns + pb = pb + ps(j) + xl(ii,j) = 1 + end do + go to 80 + 60 qs = q(ii) + kub = 0 + if ( ii .eq. m ) kub = ikub + call skp2(ns,ps,ws,qs,kub,xs,pb) + do j=1,ns + xl(ii,j) = xs(j) + end do + 80 continue + + lb = lb + pb + ikub = ikub - pb + v(ii) = pb + bl(ii,ns+1) = n + 1 +c +c step 3. +c + if ( ii .eq. m ) return + jb = 1 + jbs = 0 + do 100 j=1,u + if ( bs(j) .lt. bl(ii,jb) ) go to 90 + jb = jb + 1 + if ( xl(ii,jb-1) .eq. 1 ) go to 100 + 90 jbs = jbs + 1 + bs(jbs) = bs(j) + 100 continue + u = jbs + if ( u .eq. 0 ) return + ns = 0 + sb = 0 + ii = ii + 1 + do 110 j=1,u + jj = bs(j) + if( w(jj) .gt. q(ii) ) go to 110 + ns = ns + 1 + sb = sb + w(jj) + bl(ii,ns) = jj + ps(ns) = p(jj) + ws(ns) = w(jj) + 110 continue + + go to 40 + end + subroutine prepen(n,m,p,w,q,b,a,mind,pak,kap,pakl,ip,ir,il,if, + & jdimr,jdimc) + +c*********************************************************************72 +c +cc PREPEN determines pak , kap and pakl (pointers for computing penalties) +c and ip , ir , il and if (greedy initial solutions). +c if = profit of fixed items; +c il = break item (last which fits); +c ip = profit of the first il items; +c ir = residual capacity corresponding to ip . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),q(jdimr),b(jdimc), + & a(jdimr,jdimc),mind(jdimr,jdimc),pak(jdimr,jdimc), + & kap(jdimr,jdimc),pakl(jdimr),ip(jdimr),ir(jdimr), + & il(jdimr),if(jdimr) + + do 60 i=1,m + k = 0 + isfix = 0 + do 20 js=1,n + j = mind(i,js) + if ( b(j) .eq. 0 ) go to 10 + if ( w(i,j) .gt. q(i) ) go to 20 + if ( a(i,j) .eq. (- 1) ) go to 20 + k = k + 1 + pak(i,k) = j + kap(i,j) = k + go to 20 + 10 if ( a(i,j) .eq. 1 ) isfix = isfix + p(i,j) + 20 continue + pakl(i) = k + lk = 0 + ipk = 0 + irk = q(i) + if ( k .eq. 0 ) go to 50 + do 30 jk=1,k + j = pak(i,jk) + if ( w(i,j) .gt. irk ) go to 40 + irk = irk - w(i,j) + ipk = ipk + p(i,j) + 30 continue + lk = k + go to 50 + 40 lk = jk - 1 + 50 ip(i) = ipk + ir(i) = irk + il(i) = lk + if(i) = isfix + 60 continue + return + end + subroutine presp(n,w,c,itc,itco,ind,nc,ni,jsum) + +c*********************************************************************72 +c +cc PRESP defines the core problem. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(n),ind(itco) + integer c + nc = c + do i=1,n + if ( w(i) .gt. nc ) go to 20 + nc = nc - w(i) + end do + 20 ll = i - 1 + inch = itc/2 + if ( itc - inch .gt. n - ll ) inch = itc - (n - ll) + if ( inch .gt. ll ) inch = ll + l = ll + jsum = 0 + lli = ll + + do i=1,inch + nc = nc + w(lli) + ind(i) = lli + jsum = jsum + w(lli) + l = l - 1 + if ( i .lt. inch ) lli = lli - (lli - 1)/(inch - i) + end do + + ni = ll + iav = itc - inch + if ( ll + iav .gt. n ) iav = n - ll + l = inch + 1 + lli = ll + 1 + + do i=1,iav + if ( w(lli) .le. nc ) then + ind(l) = lli + jsum = jsum + w(lli) + l = l + 1 + if ( i .lt. iav ) lli = lli + (n - lli)/(iav - i) + end if + end do + + itc = l - 1 + if ( jsum .gt. nc ) jsum = 0 + return + end + subroutine rearr(n,p,w,m,c,z,x,cr,inf,jdn,jdm) + +c*********************************************************************72 +c +cc REARR re-arranges the initial solution. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdn),w(jdn),c(jdm),x(jdn),cr(jdm),z + z = 0 + i = 1 + j = n + ibar = 1 + do kk=1,m + cr(kk) = c(kk) + end do + mp1 = m + 1 + p(n+1) = 0 + w(n+1) = inf + 20 if ( x(j) .eq. mp1 ) go to 40 + if ( w(j) .gt. cr(i) ) go to 30 + x(j) = i + cr(i) = cr(i) - w(j) + z = z + p(j) + go to 40 + 30 i = i + 1 + if ( i .gt. m ) i = 1 + if ( i .ne. ibar ) go to 20 + x(j) = mp1 + i = i - 1 + 40 j = j - 1 + if ( j .eq. 0 ) go to 50 + i = i + 1 + if ( i .gt. m ) i = 1 + ibar = i + go to 20 + 50 maxc = cr(1) + imaxc = 1 + do 60 i=2,m + if ( cr(i) .le. maxc ) go to 60 + maxc = cr(i) + imaxc = i + 60 continue + do 80 j=1,n + if ( x(j) .lt. mp1 ) go to 80 + if ( w(j) .gt. maxc ) go to 80 + cr(imaxc) = cr(imaxc) - w(j) + z = z + p(j) + x(j) = imaxc + maxc = cr(1) + imaxc = 1 + do 70 i=2,m + if ( cr(i) .le. maxc ) go to 70 + maxc = cr(i) + imaxc = i + 70 continue + 80 continue + return + end + subroutine redns(n,p,w,izc,iz1,icw,ff,nnfo,nnf,nf,fn1,fn0) + +c*********************************************************************72 +c +cc REDNS reduces, without sorting, the items not in core. +c +c Discussion: +c +c ff(1) to ff(nnfo) = free items (input); +c ff(1) to ff(nnf) = free items (output). +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(n),w(n),ff(n),nf(n),fn1,fn0 +c +c determine the break item jbr. +c + ic = icw + ip = 0 + do i=1,nnfo + j = ff(i) + if ( w(j) .gt. ic ) go to 20 + ic = ic - w(j) + ip = ip + p(j) + end do + 20 jbr = i +c +c reduce the items in n1. +c + ir = fn1 + 30 if ( ir .gt. n ) go to 70 + icr = ic + w(ir) + ipr = ip - p(ir) + do 40 i=jbr,nnfo + j = ff(i) + if ( w(j) .gt. icr ) go to 50 + icr = icr - w(j) + ipr = ipr + p(j) + 40 continue + j = ff(nnfo) + 50 iub = ipr + icr*p(j)/w(j) + if ( iub .le. izc ) go to 60 +c +c item ir cannot be fixed to 1. +c + nnf = nnf + 1 + ff(nnf) = ir + iz1 = iz1 - p(ir) + icw = icw + w(ir) + 60 ir = nf(ir) + go to 30 +c +c reduce the items in n0. +c + 70 ir = fn0 + 80 if ( ir .gt. n ) return + if ( w(ir) .gt. icw ) go to 120 + icr = ic - w(ir) + ipr = ip + p(ir) + i = jbr + j = ff(i) + 90 if ( icr .ge. 0 ) go to 110 + i = i - 1 + if ( i .eq. 0 ) go to 100 + j = ff(i) + icr = icr + w(j) + ipr = ipr - p(j) + go to 90 + 100 j = ff(1) + 110 iub = ipr + icr*p(j)/w(j) + if ( iub .le. izc ) go to 120 +c +c item ir cannot be fixed to 0. +c + nnf = nnf + 1 + ff(nnf) = ir + 120 ir = nf(ir) + go to 80 + end + subroutine reds(n,ps,ws,p,w,c,ia1,np1,nnf,x,iz1,izh,icw,ia2) + +c*********************************************************************72 +c +cc REDS reduces the original problem. +c +c Discussion: +c +c It is assumed that the items are sorted +c according to decreasing profit per unit weight. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer ps(np1),ws(np1),p(n),w(n),x(n),ia1(n),ia2(n) + integer c,cwr,ap,ar,fr,r,sw +c +c initialize. +c + nnf = 0 + ip = 0 + cwr = c + j = 1 + 10 if ( cwr .le. ws(j) ) go to 20 + cwr = cwr - ws(j) + ip = ip + ps(j) + j = j + 1 + go to 10 + 20 r = j + jbr = ia1(r) + if ( cwr .lt. ws(j) ) go to 50 + izh = ip + ps(r) + do j=1,r + jj = ia1(j) + x(jj) = 1 + end do + ir = r + 1 + do j=ir,n + jj = ia1(j) + x(jj) = 0 + end do + return +c +c compute the upper bound. +c + 50 ll = j - 1 + ps(np1) = 0 + ws(np1) = c + 1 + iub = ip + cwr*ps(ll+2)/ws(ll+2) + a = ws(ll+1) - cwr + iub1 = float(ip + ps(ll+1)) - a*float(ps(ll))/float(ws(ll)) + if ( iub1 .gt. iub ) iub = iub1 +c +c greedy solution. +c + izg = ip + icwr = cwr + ig = ll + do 60 i=j,n + if ( ws(i) .gt. icwr ) go to 60 + ig = i + izg = izg + ps(i) + icwr = icwr - ws(i) + 60 continue + if ( izg .lt. iub ) go to 120 +c +c determine the greedy solution (optimal). +c + izh = izg + + do i=1,ll + ii = ia1(i) + x(ii) = 1 + end do + + icw = cwr + if ( j .gt. ig ) go to 100 + do 90 i=j,ig + ii = ia1(i) + if ( ws(i) .gt. icw ) go to 80 + x(ii) = 1 + icw = icw - ws(i) + go to 90 + 80 x(ii) = 0 + 90 continue + 100 if ( ig .eq. n ) return + ig1 = ig + 1 + do 110 i=ig1,n + ii = ia1(i) + x(ii) = 0 + 110 continue + return + 120 izh = izg +c +c compute f(i) for i .le. r . +c + jflag = 0 + do 150 i=1,r + ar = cwr + ws(i) + ap = ip - ps(i) + k = r + 130 if ( ar .lt. ws(k) ) go to 140 + ar = ar - ws(k) + ap = ap + ps(k) + k = k + 1 + go to 130 + 140 ii = ia1(i) + x(ii) = ap + ar*ps(k)/ws(k) + if ( izh .ge. ap ) go to 150 + izh = ap + if ( izh .eq. iub ) go to 280 + 150 continue + fr = x(jbr) +c +c compute f(i) for i .ge. r . +c + jflag = 1 + do 180 i=r,n + ar = cwr - ws(i) + ap = ip + ps(i) + k = r + 160 if ( ar .ge. 0 ) go to 170 + k = k - 1 + ar = ar + ws(k) + ap = ap - ps(k) + go to 160 + 170 ii = ia1(i) + x(ii) = ap + ar*ps(k)/ws(k) + if ( izh .ge. ap ) go to 180 + izh = ap + if ( izh .eq. iub ) go to 280 + 180 continue +c +c try to insert items in the solution. +c + jr = r - 1 + icw = c + sw = 0 + iz1 = 0 + do 200 i=1,jr + ii = ia1(i) + if ( x(ii) .lt. izh ) go to 190 + x(ii) = 2 + nnf = nnf + 1 + ia2(nnf) = ii + sw = sw + ws(i) + go to 200 + 190 x(ii) = 1 + icw = icw - ws(i) + iz1 = iz1 + ps(i) + 200 continue + ir = r + if ( fr .ge. izh ) go to 210 + x(jbr) = 1 + icw = icw - ws(r) + iz1 = iz1 + ps(r) + ir = r + 1 + if ( ir .gt. n ) go to 240 + 210 do 230 i=ir,n + ii = ia1(i) + if ( x(ii) .lt. izh ) go to 220 + x(ii) = 2 + nnf = nnf + 1 + ia2(nnf) = ii + sw = sw + ws(i) + go to 230 + 220 x(ii) = 0 + 230 continue + 240 if ( nnf .eq. 0 ) return + nnn = nnf + nnf = 0 + do 260 i=1,nnn + ii = ia2(i) + if ( w(ii) .le. icw ) go to 250 + x(ii) = 0 + sw = sw - w(ii) + go to 260 + 250 nnf = nnf + 1 + ia2(nnf) = ii + 260 continue + if ( icw .lt. sw ) return + if ( nnf .eq. 0 ) return + do 270 i=1,nnf + ii = ia2(i) + x(ii) = 1 + iz1 = iz1 + p(ii) + 270 continue + izh = iz1 + nnf = 0 + return +c +c determine the heuristic solution (optimal). +c + 280 if ( k .eq. 1 ) go to 300 + k1 = k - 1 + do j=1,k1 + jj = ia1(j) + x(jj) = 1 + end do + + 300 if ( k .gt. n ) go to 320 + + do j=k,n + jj = ia1(j) + x(jj) = 0 + end do + + 320 x(ii) = jflag + return + end + subroutine redu(n,po,wo,jdim,jpx,x) + +c*********************************************************************72 +c +cc REDU reduces an unbounded knapsack problem (po,wo) through dominance relations. +c +c on output, jpx is the first undominated item, x(jpx) the second, and +c so on. if y is the last one, then x(y) = 0. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer po(jdim),wo(jdim),x(jdim) + integer feq,prfeq,prj,prk +c +c initialization. +c + jpx = 1 + do j=1,n + x(j) = j + 1 + end do + x(n) = 0 + crat = float(po(1))/float(wo(1)) + 1. + prfeq = 0 + prj = 0 +c +c main iteration. +c + j = jpx + 20 iwoj = wo(j) + ipoj = po(j) + rj = float(ipoj)/float(iwoj) + if ( rj .eq. crat ) go to 30 + crat = rj + prfeq = prj + feq = j + go to 80 +c +c items k preceding j with same ratio. +c + 30 k = feq + prk = prfeq + 40 if ( (wo(k)/iwoj)*ipoj .lt. po(k) ) go to 60 +c +c item j dominates item k. +c + if ( prk .eq. 0 ) go to 50 + x(prk) = x(k) + go to 70 + 50 jpx = x(k) + go to 70 + 60 prk = k + 70 k = x(k) + if ( k .lt. j ) go to 40 +c +c items k following j. +c + 80 k = x(j) + prk = j + 90 if ( k .eq. 0 ) go to 120 + if ( (wo(k)/iwoj)*ipoj .lt. po(k) ) go to 100 +c +c item j dominates item k. +c + x(prk) = x(k) + go to 110 + 100 prk = k + 110 k = x(k) + go to 90 + 120 prj = j + j = x(j) + if ( j .gt. 0 ) go to 20 + return + end + subroutine restor(k,zz,n,c,kfix,fixit,w,x,r,lastw,jdim) + +c*********************************************************************72 +c +cc RESTOR restores the situation preceding the reduction of level k and update lastw . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer kfix(jdim),fixit(jdim),w(jdim),x(jdim),r(jdim) + integer zz,c + i = kfix(k) + kfix(k) = 0 + 10 next = fixit(i) + fixit(i) = 0 + j = x(i) + r(j) = r(j) + w(i) + if ( next .eq. (- 1) ) go to 20 + i = next + go to 10 + 20 if ( r(zz) .lt. c ) go to 30 + zz = zz - 1 + go to 20 + 30 do 40 ii=1,n + i = n - ii + 1 + if ( fixit(i) .eq. 0 ) go to 50 + 40 continue +c +c no exit this way. +c + 50 lastw = w(i) + return + end + subroutine search(n,w,r,nl,jdim) + +c*********************************************************************72 +c +cc SEARCH finds the largest NL such that R < W(NL). +c +c given w(1),...,w(n) , sorted by decreasing values, find, through +c binary search, the largest nl such that w(nl) .gt. r . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer w(jdim) + n1 = 1 + n2 = n + 10 if ( n2 - n1 .le. 2 ) go to 30 + nl = (n1 + n2)/2 + if ( float(w(nl)) .gt. r ) go to 20 + n2 = nl - 1 + go to 10 + 20 n1 = nl + 1 + go to 10 + 30 do 40 i=n1,n2 + if ( float(w(i)) .le. r ) go to 50 + 40 continue + nl = n2 + return + 50 nl = i - 1 + return + end + subroutine sigma(n,m,p,w,q,i,b,kub,ub) + +c*********************************************************************72 +c +cc SIGMA computes an upper bound ub on the best final solution which +c can be obtained from the current solution. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(1000),w(1000),q(10),b(1001),ub + integer bs,ps,qs,sb,ws,xs + common /sngl/ bs(1000),ps(1001),ws(1001),xs(1000) + common /pub/ lx(1000),lxi(1000),lr,lri,lubi + ns = 0 + + qs = 0 + do j=i,m + qs = qs + q(j) + end do + + sb = 0 + do 20 j=1,n + lx(j) = 0 + if ( b(j) .eq. 0 ) go to 20 + ns = ns + 1 + bs(ns) = j + ps(ns) = p(j) + ws(ns) = w(j) + sb = sb + w(j) + 20 continue + if ( sb .gt. qs ) go to 40 + lr = qs - sb + ub = 0 + if ( ns .eq. 0 ) return + do 30 j=1,ns + ub = ub + ps(j) + xs(j) = 1 + 30 continue + go to 50 + 40 call skp2(ns,ps,ws,qs,kub,xs,ub) + lr = qs + 50 do j=1,ns + jj = bs(j) + lx(jj) = xs(j) + end do + + return + end + subroutine skp1(n,p,w,kqi,vsti,i,kqri,b,a,x,y,u,jstep, + & jdimr,jdimc,jdimc1,kpunt,jp,kx,kp,kw,r,dmyc1, + & dmyc2,dmyc3,dmyc4,dmyc5) + +c*********************************************************************72 +c +cc SKP1 solves a 0-1 single knapsack problem. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),b(jdimc), + & a(jdimr,jdimc),u(jdimc),vsti,x(jdimr,jdimc),y(jdimc) + integer kpunt(jdimc),jp(jdimc),kp(jdimc1),kw(jdimc1),kx(jdimc) + integer dmyc1(jdimc),dmyc2(jdimc),dmyc3(jdimc),dmyc4(jdimc), + & dmyc5(jdimc) + real r(jdimc) + kn = 0 + ksw = 0 + do 10 j=1,n + if ( b(j) .le. 0 ) go to 10 + if ( a(i,j) .ne. 0 ) go to 10 + if ( w(i,j) .gt. kqi ) go to 10 + kkp = p(i,j) - u(j) + if ( kkp .le. 0 ) go to 10 + kn = kn + 1 + r(kn) = float(kkp)/float(w(i,j)) + jp(kn) = kn + kpunt(kn) = j + ksw = ksw + w(i,j) + 10 continue + + if ( jstep .ne. 4 ) go to 30 + + do j=1,n + y(j) = 0 + end do + + 30 kqri = kqi + if ( kn .eq. 0 ) return + if ( ksw .gt. kqi ) go to 50 + + do kj=1,kn + j = kpunt(kj) + vsti = vsti + (p(i,j) - u(j)) + kqri = kqri - w(i,j) + if ( jstep .eq. 2 ) x(i,j) = 1 + if ( jstep .eq. 4 ) y(j) = 1 + end do + + return + 50 call sortr(kn,r,jp,jdimc) + + do kj=1,kn + k = jp(kj) + j = kpunt(k) + kp(kj) = p(i,j) - u(j) + kw(kj) = w(i,j) + jp(kj) = j + end do + + mubf = 0 + jvsti = - 1 + call kpmax(kn,kp,kw,kqi,jvsti,kx,mubf,jdimc+1,jdimc, + & dmyc1,dmyc2,dmyc3,dmyc4,dmyc5) + vsti = vsti + jvsti + kqri = kqi + + do kj=1,kn + j = jp(kj) + if ( jstep .eq. 2 ) x(i,j) = kx(kj) + if ( jstep .eq. 4 ) y(j) = kx(kj) + kqri = kqri - kx(kj)*w(i,j) + end do + + return + end + subroutine skp2(ns,ps,ws,qs,kub,xs,vs) + +c*********************************************************************72 +c +cc SKP2 solves the 0-1 single knapsack problem +c +c maximize vs = ps(1)*xs(1) + ... + ps(ns)*xs(ns) +c subject to: ws(1)*xs(1) + ... + ws(ns)*xs(ns) .le. qs , +c xs(j) = 0 or 1 for j=1,...,ns, +c vs .gt. kub . +c +c this subroutine is a modified version of subroutine mt1. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer ps(1001),ws(1001),xs(1000),qs,vs + integer d(1000),min(1000),pbar(1000),wbar(1000),zbar(1000) + integer diff,pr,r,t + vs = kub + ip = 0 + ms = qs + do l=1,ns + ll = l + if ( ws(l) .gt. ms ) go to 20 + ip = ip + ps(l) + ms = ms - ws(l) + end do + + 20 ll = ll - 1 + if ( ms .eq. 0 ) go to 50 + ps(ns+1) = 0 + ws(ns+1) = qs + 1 + lim = ip + ms*ps(ll+2)/ws(ll+2) + a = ip + ps(ll+1) + b = (ws(ll+1) - ms)*ps(ll) + c = ws(ll) + lim1 = a - b/c + if ( lim1 .gt. lim ) lim = lim1 + if ( lim .le. vs ) return + mink = qs + 1 + min(ns) = mink + + do j=2,ns + kk = ns + 2 - j + if ( ws(kk) .lt. mink ) mink = ws(kk) + min(kk-1) = mink + end do + + do j=1,ns + d(j) = 0 + end do + + pr = 0 + lold = ns + ii = 1 + go to 170 + 50 if ( vs .ge. ip ) return + vs = ip + + do j=1,ll + xs(j) = 1 + end do + + nn = ll + 1 + + do j=nn,ns + xs(j) = 0 + end do + + qs = 0 + return + 80 if ( ws(ii) .le. qs ) go to 90 + ii1 = ii + 1 + if ( vs .ge. qs*ps(ii1)/ws(ii1) + pr ) go to 280 + ii = ii1 + go to 80 + 90 ip = pbar(ii) + ms = qs - wbar(ii) + in = zbar(ii) + ll = ns + if ( in .gt. ns ) go to 110 + do 100 l=in,ns + ll = l + if ( ws(l) .gt. ms ) go to 160 + ip = ip + ps(l) + ms = ms - ws(l) + 100 continue + 110 if ( vs .ge. ip + pr ) go to 280 + vs = ip + pr + mfirst = ms + nn = ii - 1 + do 120 j=1,nn + xs(j) = d(j) + 120 continue + do 130 j=ii,ll + xs(j) = 1 + 130 continue + if ( ll .eq. ns ) go to 150 + nn = ll + 1 + do 140 j=nn,ns + xs(j) = 0 + 140 continue + 150 if ( vs .ne. lim ) go to 280 + qs = mfirst + return + 160 l = ll + ll = ll - 1 + if ( ms .eq. 0 ) go to 110 + if ( vs .ge. pr + ip + ms*ps(l)/ws(l) ) go to 280 + 170 wbar(ii) = qs - ms + pbar(ii) = ip + zbar(ii) = ll + 1 + d(ii) = 1 + nn = ll - 1 + + do j=ii,nn + wbar(j+1) = wbar(j) - ws(j) + pbar(j+1) = pbar(j) - ps(j) + zbar(j+1) = ll + 1 + d(j+1) = 1 + end do + + j1 = ll + 1 + + do j=j1,lold + wbar(j) = 0 + pbar(j) = 0 + zbar(j) = j + end do + + lold = ll + qs = ms + pr = pr + ip + if ( ll - (ns - 2) ) 240, 220, 210 + 210 ii = ns + go to 250 + 220 if ( qs .lt. ws(ns) ) go to 230 + qs = qs - ws(ns) + pr = pr + ps(ns) + d(ns) = 1 + 230 ii = ns - 1 + go to 250 + 240 ii = ll + 2 + if ( qs .ge. min(ii-1) ) go to 80 + 250 if ( vs .ge. pr ) go to 270 + vs = pr + do 260 j=1,ns + xs(j) = d(j) + 260 continue + mfirst = qs + if ( vs .eq. lim ) return + 270 if ( d(ns) .eq. 0 ) go to 280 + d(ns) = 0 + qs = qs + ws(ns) + pr = pr - ps(ns) + 280 nn = ii - 1 + if ( nn .eq. 0 ) go to 300 + do 290 j=1,nn + kk = ii - j + if ( d(kk) .eq. 1 ) go to 310 + 290 continue + 300 qs = mfirst + return + 310 r = qs + qs = qs + ws(kk) + pr = pr - ps(kk) + d(kk) = 0 + if ( r .lt. min(kk) ) go to 320 + ii = kk + 1 + go to 80 + 320 nn = kk + 1 + ii = kk + 330 if ( vs .ge. pr + qs*ps(nn)/ws(nn) ) go to 280 + diff = ws(nn) - ws(kk) + if ( diff ) 390, 340, 350 + 340 nn = nn + 1 + go to 330 + 350 if ( diff .gt. r ) go to 340 + if ( vs .ge. pr + ps(nn) ) go to 340 + vs = pr + ps(nn) + do 360 j=1,kk + xs(j) = d(j) + 360 continue + jj = kk + 1 + do 370 j=jj,ns + xs(j) = 0 + 370 continue + xs(nn) = 1 + mfirst = qs - ws(nn) + if ( vs .ne. lim ) go to 380 + qs = mfirst + return + 380 r = r - diff + kk = nn + nn = nn + 1 + go to 330 + 390 t = r - diff + if ( t .lt. min(nn) ) go to 340 + n = nn + 1 + if ( vs .ge. pr + ps(nn) + t*ps(n)/ws(n) ) go to 280 + qs = qs - ws(nn) + pr = pr + ps(nn) + d(nn) = 1 + ii = nn + 1 + wbar(nn) = ws(nn) + pbar(nn) = ps(nn) + zbar(nn) = ii + n1 = nn + 1 + + do j=n1,lold + wbar(j) = 0 + pbar(j) = 0 + zbar(j) = j + end do + + lold = nn + go to 80 + end + subroutine sol(n,b,xt,jdim1,jdim2,x) + +c*********************************************************************72 +c +cc SOL determines the solution vector x for the original problem. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer b(jdim1),xt(jdim2),x(jdim1) + nt = 0 + do 20 j=1,n + isum = 0 + id = 1 + x(j) = 0 + 10 nt = nt + 1 + isum = isum + id + x(j) = x(j) + id*xt(nt) + id = id*2 + if ( id + isum .le. b(j) ) go to 10 + if ( isum .eq. b(j) ) go to 20 + id = b(j) - isum + nt = nt + 1 + x(j) = x(j) + id*xt(nt) + 20 continue + return + end + subroutine sort7(na,a,i) + +c*********************************************************************72 +c +cc SORT7 sorts in increasing order the elements from +c a(i) to a(i+6) of a by performing at most 13 tests. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + dimension a(na) + i1 = i + 1 + i2 = i + 2 + i3 = i + 3 + i4 = i + 4 + i5 = i + 5 + i6 = i + 6 + if ( a(i) .gt. a(i1) ) go to 10 + a1 = a(i) + a2 = a(i1) + go to 20 + 10 a1 = a(i1) + a2 = a(i) + 20 if ( a(i2) .gt. a(i3) ) go to 30 + a3 = a(i2) + a4 = a(i3) + go to 40 + 30 a3 = a(i3) + a4 = a(i2) + 40 if ( a1 .gt. a3 ) go to 50 + a5 = a2 + a2 = a3 + a3 = a4 + go to 60 + 50 a5 = a4 + aux = a3 + a3 = a2 + a2 = a1 + a1 = aux + 60 a4 = a(i4) + if ( a4 .ge. a2 ) go to 80 + if ( a4 .ge. a1 ) go to 70 + a4 = a3 + a3 = a2 + a2 = a1 + a1 = a(i4) + go to 90 + 70 a4 = a3 + a3 = a2 + a2 = a(i4) + go to 90 + 80 if ( a4 .ge. a3 ) go to 90 + a4 = a3 + a3 = a(i4) + 90 a(i) = a1 + if ( a5 .gt. a3 ) go to 110 + a(i3) = a3 + a(i4) = a4 + if ( a5 .gt. a2 ) go to 100 + a(i1) = a5 + a(i2) = a2 + go to 130 + 100 a(i1) = a2 + a(i2) = a5 + go to 130 + 110 a(i1) = a2 + a(i2) = a3 + if ( a5 .gt. a4 ) go to 120 + a(i3) = a5 + a(i4) = a4 + go to 130 + 120 a(i3) = a4 + a(i4) = a5 + 130 a5 = a(i5) + if ( a5 .lt. a(i2) ) go to 150 + if ( a5 .lt. a(i3) ) go to 140 + if ( a5 .ge. a(i4) ) go to 180 + a(i5) = a(i4) + a(i4) = a5 + go to 180 + 140 a(i5) = a(i4) + a(i4) = a(i3) + a(i3) = a5 + go to 180 + 150 a(i5) = a(i4) + a(i4) = a(i3) + a(i3) = a(i2) + if ( a5 .lt. a(i1) ) go to 160 + a(i2) = a5 + go to 180 + 160 a(i2) = a(i1) + if ( a5 .lt. a(i) ) go to 170 + a(i1) = a5 + go to 180 + 170 a(i1) = a(i) + a(i) = a5 + 180 a6 = a(i6) + if ( a6 .lt. a(i3) ) go to 200 + if ( a6 .lt. a(i4) ) go to 190 + if ( a6 .ge. a(i5) ) return + a(i6) = a(i5) + a(i5) = a6 + return + 190 a(i6) = a(i5) + a(i5) = a(i4) + a(i4) = a6 + return + 200 a(i6) = a(i5) + a(i5) = a(i4) + a(i4) = a(i3) + if ( a6 .lt. a(i1) ) go to 220 + if ( a6 .lt. a(i2) ) go to 210 + a(i3) = a6 + return + 210 a(i3) = a(i2) + a(i2) = a6 + return + 220 a(i3) = a(i2) + a(i2) = a(i1) + if ( a6 .lt. a(i) ) go to 230 + a(i1) = a6 + return + 230 a(i1) = a(i) + a(i) = a6 + return + end + subroutine sorti(n,a,v,jda) + +c*********************************************************************72 +c +cc SORTI sorts the integer array a by decreasing values (derived from +c subroutine sortzv of the c.e.r.n. library). +c +c jda = length of array a; +c n = number of elements of a to be sorted; +c v(i) (input) = pointer to the i-th element to be sorted; +c v(i) (output) = pointer to the i-th element of the sorted array. +c +c on return, array a is unchanged. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer v(n),iu(20),il(20) + integer a(jda),t + ii = 1 + jj = n + if ( n .le. 1 ) return + m = 1 + i = ii + j = jj + 10 if ( i .ge. j ) go to 80 + 20 k = i + ij = (j + i)/2 + iv = v(ij) + t = a(iv) + ki = v(i) + if ( a(ki) .ge. t ) go to 30 + v(ij) = ki + v(i) = iv + iv = v(ij) + t = a(iv) + 30 l = j + ki = v(j) + if ( a(ki) .le. t ) go to 50 + v(ij) = ki + v(j) = iv + iv = v(ij) + t = a(iv) + ki = v(i) + if ( a(ki) .ge. t ) go to 50 + v(ij) = ki + v(i) = iv + iv = v(ij) + t = a(iv) + go to 50 + 40 v(l) = v(k) + v(k) = ivt + 50 l = l - 1 + ki = v(l) + if ( a(ki) .lt. t ) go to 50 + ivt = ki + 60 k = k + 1 + ki = v(k) + if ( a(ki) .gt. t ) go to 60 + if ( k .le. l ) go to 40 + if ( l - i .le. j - k ) go to 70 + il(m) = i + iu(m) = l + i = k + m = m + 1 + go to 90 + 70 il(m) = k + iu(m) = j + j = l + m = m + 1 + go to 90 + 80 m = m - 1 + if ( m .eq. 0 ) return + i = il(m) + j = iu(m) + 90 if ( j - i .ge. ii ) go to 20 + if ( i .eq. ii ) go to 10 + i = i - 1 + 100 i = i + 1 + if ( i .eq. j ) go to 80 + iv = v(i+1) + t = a(iv) + ki = v(i) + if ( a(ki) .ge. t ) go to 100 + k = i + 110 v(k+1) = v(k) + k = k - 1 + ki = v(k) + if ( t .gt. a(ki) ) go to 110 + v(k+1) = iv + go to 100 + end + subroutine sorti2(n,a,v,jda) + +c*********************************************************************72 +c +cc SORTI2 index-sorts the integer array a by increasing values. +c +c jda = length of array a; +c n = number of elements of a to be sorted; +c v(i) (input) = pointer to the i-th element to be sorted; +c v(i) (output) = pointer to the i-th element of the sorted array. +c +c on return, array a is unchanged. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer v(n),iu(20),il(20) + integer a(jda),t + ii = 1 + jj = n + if ( n .le. 1 ) return + m = 1 + i = ii + j = jj + 10 if ( i .ge. j ) go to 80 + 20 k = i + ij = (j + i)/2 + iv = v(ij) + t = a(iv) + ki = v(i) + if ( a(ki) .le. t ) go to 30 + v(ij) = ki + v(i) = iv + iv = v(ij) + t = a(iv) + 30 l = j + ki = v(j) + if ( a(ki) .ge. t ) go to 50 + v(ij) = ki + v(j) = iv + iv = v(ij) + t = a(iv) + ki = v(i) + if ( a(ki) .le. t ) go to 50 + v(ij) = ki + v(i) = iv + iv = v(ij) + t = a(iv) + go to 50 + 40 v(l) = v(k) + v(k) = ivt + 50 l = l - 1 + ki = v(l) + if ( a(ki) .gt. t ) go to 50 + ivt = ki + 60 k = k + 1 + ki = v(k) + if ( a(ki) .lt. t ) go to 60 + if ( k .le. l ) go to 40 + if ( l - i .le. j - k ) go to 70 + il(m) = i + iu(m) = l + i = k + m = m + 1 + go to 90 + 70 il(m) = k + iu(m) = j + j = l + m = m + 1 + go to 90 + 80 m = m - 1 + if ( m .eq. 0 ) return + i = il(m) + j = iu(m) + 90 if ( j - i .ge. ii ) go to 20 + if ( i .eq. ii ) go to 10 + i = i - 1 + 100 i = i + 1 + if ( i .eq. j ) go to 80 + iv = v(i+1) + t = a(iv) + ki = v(i) + if ( a(ki) .le. t ) go to 100 + k = i + 110 v(k+1) = v(k) + k = k - 1 + ki = v(k) + if ( t .lt. a(ki) ) go to 110 + v(k+1) = iv + go to 100 + end + subroutine sortr(n,a,v,jda) + +c*********************************************************************72 +c +cc SORTR index-sorts the real array a by decreasing values. +c +c jda = length of array a; +c n = number of elements of a to be sorted; +c v(i) (input) = pointer to the i-th element to be sorted; +c v(i) (output) = pointer to the i-th element of the sorted array. +c +c on return, array a is unchanged. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer v(n),iu(20),il(20) + real a(jda) + ii = 1 + jj = n + if ( n .le. 1 ) return + m = 1 + i = ii + j = jj + 10 if ( i .ge. j ) go to 80 + 20 k = i + ij = (j + i)/2 + iv = v(ij) + t = a(iv) + ki = v(i) + if ( a(ki) .ge. t ) go to 30 + v(ij) = ki + v(i) = iv + iv = v(ij) + t = a(iv) + 30 l = j + ki = v(j) + if ( a(ki) .le. t ) go to 50 + v(ij) = ki + v(j) = iv + iv = v(ij) + t = a(iv) + ki = v(i) + if ( a(ki) .ge. t ) go to 50 + v(ij) = ki + v(i) = iv + iv = v(ij) + t = a(iv) + go to 50 + 40 v(l) = v(k) + v(k) = ivt + 50 l = l - 1 + ki = v(l) + if ( a(ki) .lt. t ) go to 50 + ivt = ki + 60 k = k + 1 + ki = v(k) + if ( a(ki) .gt. t ) go to 60 + if ( k .le. l ) go to 40 + if ( l - i .le. j - k ) go to 70 + il(m) = i + iu(m) = l + i = k + m = m + 1 + go to 90 + 70 il(m) = k + iu(m) = j + j = l + m = m + 1 + go to 90 + 80 m = m - 1 + if ( m .eq. 0 ) return + i = il(m) + j = iu(m) + 90 if ( j - i .ge. ii ) go to 20 + if ( i .eq. ii ) go to 10 + i = i - 1 + 100 i = i + 1 + if ( i .eq. j ) go to 80 + iv = v(i+1) + t = a(iv) + ki = v(i) + if ( a(ki) .ge. t ) go to 100 + k = i + 110 v(k+1) = v(k) + k = k - 1 + ki = v(k) + if ( t .gt. a(ki) ) go to 110 + v(k+1) = iv + go to 100 + end + subroutine tab(tda,tdb,nsd,wk,c,jddx,jdd,jbit,jflag) + +c*********************************************************************72 +c +cc TAB builds the new dynamic programming list TDB from the current list TDA. +c +c Discussion: +c +c The routine adds the states which can be obtained from wk . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer wk,c,tda(jdd,2),tdb(jdd,2) + jflag = 0 + tda(nsd+1,1) = 2*c + 1 + ka = 1 + kas = 1 + kb = 0 + newst = wk + newsol = jbit + 10 if ( newst - tda(ka,1) ) 20 , 30 , 40 + 20 kb = kb + 1 + if ( kb .gt. jddx ) go to 60 + tdb(kb,1) = newst + tdb(kb,2) = newsol + 30 if ( kas .eq. nsd ) go to 50 + kas = kas + 1 + newst = wk + tda(kas,1) + newsol = jbit + tda(kas,2) + if ( newst .le. c ) go to 10 + if ( ka .gt. nsd ) go to 50 + go to 10 + 40 kb = kb + 1 + if ( kb .gt. jddx ) go to 60 + tdb(kb,1) = tda(ka,1) + tdb(kb,2) = tda(ka,2) + ka = ka + 1 + go to 10 + 50 nsd = kb + if ( tdb(nsd,1) .gt. c ) nsd = nsd - 1 + go to 70 + 60 jflag = - 1 + 70 continue + return + end + subroutine termin(jfi,invst,jub,imult,z,kvst,numnod,minmax, + & m,n,p,lam,jdimr,jdimc,jb,back) + +c*********************************************************************72 +c +cc TERMIN terminates execution. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer z,p(jdimr,jdimc),back + integer zm + if ( jfi .eq. 1 ) go to 10 + if ( jub .lt. z ) jub = z + jb = invst - jub*imult + if ( z .eq. (-7) ) go to 10 + zm = z + z = 0 + if ( zm .gt. kvst ) z = invst - zm*imult + back = numnod + 10 if ( minmax .eq. 2 ) return +c +c Restore the original minimization problem. +c + do i=1,m + do j=1,n + if ( p(i,j) .gt. 0 ) p(i,j) = lam - p(i,j) + end do + end do + + return + end + subroutine timestamp ( ) + +c*********************************************************************72 +c +cc TIMESTAMP prints out the current YMDHMS date as a timestamp. +c +c Licensing: +c +c This code is distributed under the GNU LGPL license. +c +c Modified: +c +c 12 January 2007 +c +c Author: +c +c John Burkardt +c +c Parameters: +c +c None +c + implicit none + + character * ( 8 ) ampm + integer d + character * ( 8 ) date + integer h + integer m + integer mm + character * ( 9 ) month(12) + integer n + integer s + character * ( 10 ) time + integer y + + save month + + data month / + & 'January ', 'February ', 'March ', 'April ', + & 'May ', 'June ', 'July ', 'August ', + & 'September', 'October ', 'November ', 'December ' / + + call date_and_time ( date, time ) + + read ( date, '(i4,i2,i2)' ) y, m, d + read ( time, '(i2,i2,i2,1x,i3)' ) h, n, s, mm + + if ( h .lt. 12 ) then + ampm = 'AM' + else if ( h .eq. 12 ) then + if ( n .eq. 0 .and. s .eq. 0 ) then + ampm = 'Noon' + else + ampm = 'PM' + end if + else + h = h - 12 + if ( h .lt. 12 ) then + ampm = 'PM' + else if ( h .eq. 12 ) then + if ( n .eq. 0 .and. s .eq. 0 ) then + ampm = 'Midnight' + else + ampm = 'AM' + end if + end if + end if + + write ( *, + & '(i2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) + & d, month(m), y, h, ':', n, ':', s, '.', mm, ampm + + return + end + subroutine trans(n,p,w,b,jdim1,jdim2,nt,pt,wt) + +c*********************************************************************72 +c +cc TRANS transforms a bounded knapsack problem (n, p, w, b) into +c a 0-1 knapsack problem (nt, pt, wt ). +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdim1),w(jdim1),b(jdim1),pt(jdim2),wt(jdim2) + jdmax = jdim2 - 3 + nt = 0 + do 20 j=1,n + isum = 0 + id = 1 + 10 nt = nt + 1 + if ( nt .gt. jdmax ) go to 30 + pt(nt) = p(j)*id + wt(nt) = w(j)*id + isum = isum + id + id = id*2 + if ( id + isum .le. b(j) ) go to 10 + if ( isum .eq. b(j) ) go to 20 + id = b(j) - isum + nt = nt + 1 + if ( nt .gt. jdmax ) go to 30 + pt(nt) = p(j)*id + wt(nt) = w(j)*id + 20 continue + return + 30 nt = - 5 + return + end + subroutine trin(p,n,m,invst,lam,jdimr,jdimc) + +c*********************************************************************72 +c +cc TRIN transforms an gap in minimization form to an equivalent instance in maximization form. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc) + invst = 0 + max = 0 + do 20 j=1,n + do i=1,m + if ( p(i,j) .gt. max ) max = p(i,j) + end do + 20 continue + lam = max + 1 + do 40 j=1,n + do 30 i=1,m + p(i,j) = lam - p(i,j) + 30 continue + invst = invst + lam + 40 continue + return + end + subroutine ubfjv(n,m,p,w,q,b,a,jfjvu,xrs,vfjv,vstar,inf, + & jdimr,jdimc,jdimc1,dmyc1,dmyc2,dmyc3,dmycc1, + & dmycc2,dmycr1,dmyc4,dmyc5,dmyc6,dmyc7,dmyc8, + & u,nots,y,vst,kq,kqr,miny,x) + +c*********************************************************************72 +c +cc UBFJV computes the fisher-jaikumar-van wassenhove upper bound. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),q(jdimr),b(jdimc), + & a(jdimr,jdimc),xrs(jdimc) + integer vstar,vfjv + integer u(jdimc),vst(jdimr),kq(jdimr),kqr(jdimr), + & nots(jdimc),y(jdimc),delta,vsti + integer x(jdimr,jdimc),miny(jdimc) + integer dmyc1(jdimc),dmyc2(jdimc),dmyc3(jdimc),dmyc4(jdimc), + & dmyc5(jdimc),dmyc6(jdimc),dmyc7(jdimc),dmyc8(jdimc), + & dmycc1(jdimc1),dmycc2(jdimc1) + real dmycr1(jdimc) +c +c step 1. +c + vfjv = 0 + + do i=1,m + kq(i) = q(i) + vst(i) = 0 + do j=1,n + x(i,j) = 0 + end do + end do + + jfjvu = 0 + + do 50 j=1,n + u(j) = 0 + if ( b(j) .eq. 1 ) go to 50 + do i=1,m + if ( a(i,j) .eq. 1 ) go to 40 + end do + 40 jfjvu = jfjvu + p(i,j) + 50 continue + + 60 jrep = 0 + do 110 j=1,n + if ( b(j) .le. 0 ) go to 110 + max = - 1 + max2 = - 1 + do 80 i=1,m + if ( a (i,j) .eq. (- 1) ) go to 80 + if ( w(i,j) .gt. kq(i) ) go to 80 + if ( p(i,j) .le. max2 ) go to 80 + if ( p(i,j) .gt. max ) go to 70 + max2 = p(i,j) + go to 80 + 70 max2 = max + max = p(i,j) + imax = i + 80 continue + jfjvu = jfjvu - u(j) + u(j) = max2 + if ( max .gt. 0 ) go to 90 + jfjvu = - 1 + go to 360 + 90 if ( max2 .le. 0 ) go to 100 + jfjvu = jfjvu + u(j) + go to 110 + 100 kq(imax) = kq(imax) - w(imax,j) + jfjvu = jfjvu + p(imax,j) + b(j) = - imax + jrep = 1 + 110 continue + if ( jrep .eq. 1 ) go to 60 +c +c step 2. +c + do 120 i=1,m + call skp1(n,p,w,kq(i),vst(i),i,kqr(i),b,a,x,y,u,2, + & jdimr,jdimc,jdimc+1,dmyc1,dmyc2,dmyc3,dmycc1,dmycc2, + & dmycr1,dmyc4,dmyc5,dmyc6,dmyc7,dmyc8) + jfjvu = jfjvu + vst(i) + 120 continue +c +c step 3. +c + 130 if ( jfjvu .le. vstar ) go to 360 +c +c initialize nots. +c + jns = 0 + do 150 j=1,n + if ( b(j) .le. 0 ) go to 150 + do 140 i=1,m + if ( x(i,j) .eq. 1 ) go to 150 + 140 continue + jns = jns + 1 + nots(jns) = j + 150 continue +c +c iterative part. +c + 160 if ( jns .gt. 0 ) go to 240 + do 230 j=1,n + if ( b(j) .eq. 0 ) go to 200 + if ( b(j) .gt. 0 ) go to 170 + i = - b(j) + go to 190 + 170 do 180 i=1,m + if ( x(i,j) .eq. 1 ) go to 190 + 180 continue + 190 xrs(j) = i + vfjv = vfjv + p(i,j) + go to 230 + 200 do 210 i=1,m + if ( a(i,j) .eq. 1 ) go to 220 + 210 continue + 220 xrs(j) = i + vfjv = vfjv + p(i,j) + 230 continue + go to 360 + 240 max = - 1 + do 260 jj=1,jns + j = nots(jj) + do 250 i=1,m + if ( p(i,j) - u(j) .ne. 0 ) go to 250 + if ( w(i,j) .gt. kqr(i) ) go to 250 + if ( p(i,j) .le. max ) go to 250 + max = p(i,j) + imax = i + jmax = j + jjmax = jj + 250 continue + 260 continue + if ( max .lt. 0 ) go to 270 + x(imax,jmax) = 1 + kqr(imax) = kqr(imax) - w(imax,jmax) + nots(jjmax) = nots(jns) + jns = jns - 1 + go to 160 +c +c step 4. +c + 270 do 330 jj=1,jns + j = nots(jj) + min = inf + min2 = min + do 300 i=1,m + if ( a(i,j) .ne. 0 ) go to 300 + if ( w(i,j) .gt. kq(i) ) go to 300 + a(i,j) = - 2 + kqi = kq(i) - w(i,j) + vsti = p(i,j) - u(j) + call skp1(n,p,w,kqi,vsti,i,kqri,b,a,x,y,u,4, + & jdimr,jdimc,jdimc+1,dmyc1,dmyc2,dmyc3,dmycc1,dmycc2, + & dmycr1,dmyc4,dmyc5,dmyc6,dmyc7,dmyc8) + a(i,j) = 0 + y(j) = 1 + delta = vst(i) - vsti + if ( delta .ge. min2 ) go to 300 + if ( delta .lt. min ) go to 280 + min2 = delta + if ( min2 .le. 0 ) go to 330 + go to 300 + 280 min2 = min + min = delta + minz = vsti + minkq = kqri + mini = i + do 290 k=1,n + miny(k) = y(k) + 290 continue + if ( min2 .le. 0 ) go to 330 + 300 continue + jstar = j + istar = mini + do 320 k=1,n + if ( miny(k) .eq. 0 ) go to 320 + do 310 i=1,m + if ( i .eq. istar ) go to 310 + if ( x(i,k) .eq. 1 ) go to 330 + 310 continue + 320 continue + go to 340 + 330 continue + go to 360 +c +c step 5. +c + 340 u(jstar) = u(jstar) - min2 + vst(istar) = minz + min2 + kqr(istar) = minkq + do 350 j=1,n + x(istar,j) = miny(j) + 350 continue + jfjvu = jfjvu - min + go to 130 +c +c return. +c + 360 do 370 j=1,n + if ( b(j) .lt. 0 ) b(j) = 1 + 370 continue + return + end + subroutine ubrs(n,m,p,w,q,b,a,jrsu,xrs,vrs,z,inf, + & jdimr,jdimc,jdimc1,qh,penrs,pen,u,xk, + & dmyc1,dmyc2,dmyc3,dmyc4,dmyc5,dmyc6,dmyc7, + & ismax,kpoint,dmycc1,dmycc2,dmycr1) + +c*********************************************************************72 +c +cc UBRS computes the improved ross-soland upper bound. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer p(jdimr,jdimc),w(jdimr,jdimc),q(jdimr),b(jdimc), + & a(jdimr,jdimc),xrs(jdimc),vrs,z + integer qh(jdimr),penrs(jdimc),pen(jdimc),u(jdimc),xk(jdimc), + & ismax(jdimc),kpoint(jdimc) + integer dmyc1(jdimc),dmyc2(jdimc),dmyc3(jdimc),dmyc4(jdimc), + & dmyc5(jdimc),dmyc6(jdimc),dmyc7(jdimc) + integer dmycc1(jdimc1),dmycc2(jdimc1) + real dmycr1(jdimc) + integer fmax,smax,d + do i=1,m + qh(i) = 0 + end do + jv = 0 + mind = inf + do 60 j=1,n + if ( b(j) .eq. 1 ) go to 30 + do 20 i=1,m + if ( a(i,j) .ne. 1 ) go to 20 + jv = jv + p(i,j) + xrs(j) = i + ismax(j) = 0 + go to 60 + 20 continue + 30 fmax = - inf + if = 0 + smax = - 2*inf + do 50 i=1,m + if ( a(i,j) .eq. (- 1) ) go to 50 + if ( w(i,j) .gt. q(i) ) go to 50 + if ( smax .ge. p(i,j) ) go to 50 + if ( fmax .ge. p(i,j) ) go to 40 + smax = fmax + is = if + fmax = p(i,j) + if = i + go to 50 + 40 smax = p(i,j) + is = i + 50 continue + if ( if .eq. 0 ) go to 160 + xrs(j) = if + ismax(j) = is + jv = jv + fmax + qh(if) = qh(if) + w(if,j) + penrs(j) = fmax - smax + if ( fmax - smax .lt. mind ) mind = fmax - smax + 60 continue + do 70 i=1,m + if ( qh(i) .gt. q(i) ) go to 80 + 70 continue + jrsu = jv + vrs = jv + return + 80 jrsu = jv - mind + vrs = 0 + if ( jrsu .le. z ) return +c +c compute the minimum penalty for each unsatisfied knapsack. +c + jrsu = jv + do 120 i=1,m + if ( qh(i) .le. q(i) ) go to 120 + d = qh(i) - q(i) + kk = 0 + mind = inf + do 90 j=1,n + if ( b(j) .eq. 0 ) go to 90 + if ( xrs(j) .ne. i ) go to 90 + kk = kk + 1 + pen(kk) = penrs(j) + u(kk) = w(i,j) + if ( pen(kk) .lt. mind ) mind = pen(kk) + kpoint(kk) = j + 90 continue + if ( jrsu - mind .le. z ) go to 110 + kubf = jrsu - z + call kpmin(kk,pen,u,d,mind,xk,kubf, + & jdimc,jdimc+1,dmycc1,dmycc2,dmyc6,dmyc7,dmycr1, + & dmyc1,dmyc2,dmyc3,dmyc4,dmyc5) + do 100 kj=1,kk + if ( xk(kj) .eq. 0 ) go to 100 + j = kpoint(kj) + ismax(j) = - ismax(j) + 100 continue + 110 jrsu = jrsu - mind + if ( jrsu .le. z ) return + 120 continue +c +c try to obtain a feasible and optimal solution. +c + do 130 i=1,m + qh(i) = 0 + 130 continue + do 150 j=1,n + if ( b(j) .eq. 0 ) go to 150 + if ( ismax(j) .ge. 0 ) go to 140 + xrs(j) = - ismax(j) + 140 i = xrs(j) + qh(i) = qh(i) + w(i,j) + if ( qh(i) .gt. q(i) ) return + 150 continue + vrs = jrsu + return +c +c infeasibility. +c + 160 jrsu = 0 + vrs = - 1 + return + end + subroutine update(n,z,xstar,na,m,x,wb,xred,jdim) + +c*********************************************************************72 +c +cc UPDATE updates the optimal solution after a local heuristic. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer xstar(jdim),x(jdim),wb(jdim),xred(jdim),z + + do i=1,n + xstar(i) = x(i) + end do + + do ii=1,na + ixrii = xred(ii) + xstar(ixrii) = wb(ii) + end do + + z = m + + return + end + subroutine upstar(nx,n1,n0,xx,v,loc,x,z,lstar) + +c*********************************************************************72 +c +cc UPSTAR updates the current optimal solution. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer xx(n0),x(n0),v,z + z = v + if ( nx .eq. 0 ) go to 20 + do j=1,nx + x(j) = xx(j) + end do + + 20 if ( n1 .eq. nx ) go to 40 + nx1 = nx + 1 + do 30 j=nx1,n1 + x(j) = 1 + 30 continue + 40 if ( n0 .eq. n1 ) go to 60 + + n11 = n1 + 1 + do j=n11,n0 + x(j) = 0 + end do + + 60 lstar = loc + return + end + subroutine usedin ( c, td, jdd, nsd, loc ) + +c*********************************************************************72 +c +cc USEDIN finds the maximum vector entry that is no greater than C. +c +c Discussion: +c +c This routine determines, through binary search, the location LOC +c of the entry in TD containing the maximum value TD(LOC,1) <= C. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer c,td(jdd,2) + + if ( td(nsd,1) .gt. c ) go to 10 + loc = nsd + return + 10 minl = 1 + maxl = nsd + 20 loc = (maxl + minl)/2 + if ( td(loc,1) - c ) 30, 40, 50 + 30 minl = loc + 1 + if ( maxl .gt. minl ) go to 20 + loc = minl + if ( td(loc,1) .le. c ) return + loc = minl - 1 + 40 return + 50 maxl = loc - 1 + if ( maxl .gt. minl ) go to 20 + loc = maxl + if ( td(loc,1) .le. c ) return + loc = maxl - 1 + return + end + subroutine ydef(l,i,j,ny) + +c*********************************************************************72 +c +cc YDEF sets y(l,i,j) = NY. +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer y + common /pack/ mask1(30),itwo(30),mask,y(150,100) + iylj = y(l,j) + imask1 = mask1(i) + y(l,j) = iand ( iylj, imask1 ) + ny*itwo(i) + return + end + subroutine yuse(l,i,j,ny) + +c*********************************************************************72 +c +cc YUSE sets ny = y(l,i,j) . +c +c Modified: +c +c 06 December 2009 +c +c Author: +c +c Silvano Mortello, Paolo Toth +c +c Reference: +c +c Silvano Martello, Paolo Toth, +c Knapsack Problems: Algorithms and Computer Implementations, +c Wiley, 1990, +c ISBN: 0-471-92420-2, +c LC: QA267.7.M37. +c + integer y + common /pack/ mask1(30),itwo(30),mask,y(150,100) + iyit = y(l,j)/itwo(i) + imask = mask + + ny = iand ( iyit, imask ) + + return + end diff --git a/mknapsack/_exceptions.py b/mknapsack/_exceptions.py new file mode 100644 index 0000000..7da8a89 --- /dev/null +++ b/mknapsack/_exceptions.py @@ -0,0 +1,39 @@ +"""Module for exceptions.""" + + +class FortranInputCheckError(Exception): + error_codes = { + 'mtm': { + -1: 'Number of items/knapsacks is either too small or large', + -2: 'Profit or weight of at least one item is <= 0', + -3: 'Minimum weight is greater than smallest knapsack', + -4: 'Maximum weight is greater than largest knapsack', + -5: 'Total sum of weights is smaller than largest knapsack', + -6: 'Items should be ordered in descending profit/weight order', + -7: 'Knapsacks should be ordered in ascending order' + }, + 'mthm': { + -1: 'Number of items/knapsacks is either too small or large', + -2: 'Profit or weight of at least one item is <= 0', + -3: 'Minimum weight is greater than smallest knapsack', + -4: 'Maximum weight is greater than largest knapsack', + -5: 'Total sum of weights is smaller than largest knapsack', + -6: 'Items should be ordered in descending profit/weight order', + -7: 'Knapsacks should be ordered in ascending order' + } + } + + def __init__(self, method=None, z=None): + self.method = method + self.z = z + super().__init__() + + def __str__(self): + if self.method is None or self.z is None: + return 'Generic exception from Fortran side' + elif (self.method not in self.error_codes or + self.z not in self.error_codes[self.method]): + return ('Generic exception from Fortran side, could not resolve ' + f'error code {self.z}') + else: + return self.error_codes[self.method][self.z] diff --git a/mknapsack/_multiple.py b/mknapsack/_multiple.py new file mode 100644 index 0000000..07ff95f --- /dev/null +++ b/mknapsack/_multiple.py @@ -0,0 +1,268 @@ +"""Module for solving multiple 0-1 knapsack problems. + +TODO: + mt1: Single 0-1 knapsack problem + mt2: Single 0-1 knapsack problem + skp1: Single 0-1 knapsack problem + skp2: Single 0-1 knapsack problem + + kp01m: Single 0-1 knapsack problem, items need to be sorted according to + decreasing profit per unit weight. + mtb2: Bounded single 0-1 knapsack problem + mt1r: Single 0-1 knapsack problem with real parameters + + mtu1: Unbounded single knapsack problem + mtu2: Unbounded single knapsack problem + + mtp: Bin-packing problem + mts: Small subset-sum problem + mtsl: Subset-sum problem + + mtc1: Change-making problem + mtc2: Unbounded change-making problem + mtcb: Bounded change-making problem + + mtg: Generalized assignment problem + mthg: Generalized assignment problem with heuristics +""" + + +import logging + +from typing import List, Optional + +import numpy as np +import pandas as pd + +from mknapsack._algos import mtm, mthm +from mknapsack._exceptions import FortranInputCheckError + + +logger = logging.getLogger(__name__) + + +def preprocess_array(ar): + """Preprocess array for Fortran inputs.""" + return np.array(ar, dtype='int32', order='F') + + +def pad_array(ar, width): + """Pad array with zeros to given length.""" + assert ar.ndim == 1 + new_ar = np.zeros((width, ), dtype='int32', order='F') + n = len(ar) + new_ar[:n] = ar + return new_ar + + +def process_results(profits, weights, capacities, x): + """Preprocess multiple 0-1 knapsack results.""" + given_knapsacks = pd.DataFrame({ + 'knapsack_id': np.arange(len(capacities)) + 1, + 'knapsack_capacity': capacities + }) + no_knapsack = pd.DataFrame([{'knapsack_id': 0, 'knapsack_capacity': 0}]) + knapsacks = pd.concat([no_knapsack, given_knapsacks], axis=0) + items = ( + pd.DataFrame({ + 'item_id': np.arange(len(profits)) + 1, + 'profit': profits, + 'weight': weights, + 'knapsack_id': x[:len(profits)] + }) + .merge(knapsacks, on='knapsack_id', how='left') + .assign(assigned=lambda x: x['knapsack_id'] > 0) + ) + return items + + +def solve_multiple_knapsack( + profits: List[int], + weights: List[int], + capacities: List[int], + method: str = 'mthm', + method_kwargs: Optional[dict] = None, + verbose: bool = False +) -> pd.DataFrame: + """Solves the multiple 0-1 knapsack problem. + + Given a set of items with profits and weights and knapsacks with given + capacities, how should assign the items into knapsacks in order to maximize + profits? + + Args: + profits: Profits of each item. + weights: Weight of each item. + capacities: Capacity of each knapsack. + method: + Algorithm to use for solving, should be one of + + - 'mtm' - provides a global optimum, but may take a long time + to solve for larger problem sizes + - 'mthm' - provides a fast heuristical solution that might not + be the global optimum + + Defaults to 'mthm'. + method_kwargs: + Keyword arguments to pass to a given `method`. + + - 'mtm' + * **max_backtracks** (int, optional) - Maximum number of + backtracks to perform. Setting -1 corresponds to exact + solution. Defaults to -1. + * **check_inputs** (int) - Whether to check inputs or not + (0=no, 1=yes). Defaults to 1. + - 'mthm' + * **call_stack** (int, optional) - Operations to perform on + top of the initial solution. Should be one of + * 0 = output initial feasible solution + * 1 = try to improve solution once + * 2 = try to improve solution twice + + Defaults to 2. + * **check_inputs** (int, optional) - Whether to check + inputs or not (0=no, 1=yes). Defaults to 1. + + Defaults to None. + + Returns: + pd.DataFrame: The corresponding knapsack for each item, where + ``knapsack_id=0`` means that the item is not assigned to a knapsack. + + Raises: + FortranInputCheckError: Something is wrong with the inputs when + validated in the original Fortran source code side. + ValueError: Something is wrong with the given inputs. + + Example: + .. code-block:: python + + from mknapsack import solve_multiple_knapsack + + res = solve_multiple_knapsack( + profits=[78, 35, 89, 36, 94, 75, 74, 100, 80, 16], + weights=[18, 9, 23, 20, 59, 61, 70, 75, 76, 30], + capacities=[90, 100] + ) + + References: + * Silvano Martello, Paolo Toth, Optimal and canonical solutions of the + change-making problem, European Journal of Operational Research, + 1980. + + * Silvano Martello, Paolo Toth, Knapsack Problems: Algorithms and + Computer Implementations, Wiley, 1990, ISBN: 0-471-92420-2, + LC: QA267.7.M37. + + * `Original Fortran77 source code by Martello and Toth\ + `_ + """ + profits = preprocess_array(profits) + weights = preprocess_array(weights) + capacities = preprocess_array(capacities) + + if len(profits) != len(weights): + raise ValueError('Profits length must be equal to weights ' + f'({len(profits) != len(weights)}') + + # Sort items by profit/ratio ratio in ascending order + items_order_idx = (profits / weights).argsort()[::-1] + items_reverse_idx = np.argsort(items_order_idx) + profits = profits[items_order_idx] + weights = weights[items_order_idx] + + # Sort knapsacks by their capacity in ascending order + knapsacks_order_idx = capacities.argsort() + knapsacks_reverse_idx = knapsacks_order_idx.argsort() + capacities = capacities[knapsacks_order_idx] + + n = len(profits) + m = len(capacities) + + method = method.lower() + method_kwargs = method_kwargs or {} + if method == 'mtm': + # These are checked Fortran side as well, but would fail at padding + maxn = 1000 + maxm = 10 + if n > maxn: + raise ValueError( + f'Number of items ({n}) cannot be greater than {maxn} for ' + f'method="{method}", please try for example method="mthm"') + if m > maxm: + raise ValueError( + f'Number of knapsacks ({m}) cannot be greater than {maxm} for ' + f'method="{method}", please try for example method="mthm"') + + p = pad_array(profits, maxn) + w = pad_array(weights, maxn) + c = pad_array(capacities, maxm) + z, x, back = mtm( + n=n, + m=m, + p=p, + w=w, + c=c, + back=method_kwargs.pop('max_backtracks', -1), + jck=method_kwargs.pop('check_inputs', 1) + ) + + if z < 0: + raise FortranInputCheckError(method=method, z=z) + + if verbose: + logger.info(f'Method: "{method}"') + logger.info(f'Total profit: {z}') + logger.info('Solution vector: ' + f'{x[:n][items_reverse_idx].tolist()}') + logger.info(f'Number of backtracks: {back}') + + elif method == 'mthm': + p = pad_array(profits, n + 1) + w = pad_array(weights, n + 1) + c = pad_array(capacities, m + 1) + z, x = mthm( + n=n, + m=m, + p=p, + w=w, + c=c, + jdn=n + 1, + jdm=m + 1, + li=method_kwargs.pop('call_stack', 2), + jck=method_kwargs.pop('check_inputs', 1) + ) + + if z < 0: + raise FortranInputCheckError(method=method, z=z) + + if verbose: + logger.info(f'Method: "{method}"') + logger.info(f'Total profit: {z}') + logger.info('Solution vector: ' + f'{x[:n][items_reverse_idx].tolist()}') + else: + raise ValueError(f'Given method "{method}" not known') + + # Inverse items and knapsacks to original order + profits = profits[items_reverse_idx] + weights = weights[items_reverse_idx] + x = np.array(x)[items_reverse_idx] + capacities = capacities[knapsacks_reverse_idx] + + res = process_results(profits, weights, capacities, x) + + if verbose: + knapsack_results = ( + res + .groupby('knapsack_id') + .agg( + capacity_used=('weight', 'sum'), + capacity_available=('knapsack_capacity', 'first'), + profit=('profit', 'sum'), + items=('item_id', 'unique') + ) + ) + logger.info(f'Results by knapsack_id:\n{knapsack_results.to_string()}') + + return res diff --git a/pyproject.toml b/pyproject.toml new file mode 100644 index 0000000..4cd8b7b --- /dev/null +++ b/pyproject.toml @@ -0,0 +1,61 @@ +[project] +name = "mknapsack" +description = "Solving knapsack and bin packing problems with Python" +authors = [ + { name = "Jesse Myrberg", email = "jesse.myrberg@gmail.com" } +] +readme = "README.md" +license = { file = "LICENSE" } +keywords = ["knapsack", "bin", "packing", "optimization"] +classifiers = [ + "Development Status :: 4 - Beta", + "Programming Language :: Python :: 3", + "Intended Audience :: Developers", + "License :: OSI Approved :: MIT License" +] +requires-python = ">=3.8, <3.12" +dependencies = [ + "numpy>=1.13", + "pandas>=1.0", +] +dynamic = ["version"] + +[project.optional-dependencies] +dev = [ + "build", + "flake8", + "numpy", + "pytest", + "setuptools", + "setuptools-scm", + "twine", + "wheel" +] +docs = [ + "myst-parser", + "piccolo-theme", + "sphinx" +] + +[project.urls] +"Homepage" = "https://github.com/jmyrberg/mknapsack" +"Documentation" = "https://mknapsack.readthedocs.io" + +[build-system] +requires = [ + "setuptools", + "setuptools-scm", + "numpy", + "wheel" +] +build-backend = "setuptools.build_meta" + +[tool.setuptools.packages.find] +include = [ + "mknapsack*", + "tests*" +] + +[tool.setuptools_scm] +write_to = "mknapsack/_version.py" +local_scheme = "no-local-version" \ No newline at end of file diff --git a/python/mknapsack/_algorithms_cy/__init__.py b/python/mknapsack/_algorithms_cy/__init__.py deleted file mode 100644 index e69de29..0000000 diff --git a/python/mknapsack/_algorithms_cy/mtm_cy.pyx b/python/mknapsack/_algorithms_cy/mtm_cy.pyx deleted file mode 100644 index 7a50684..0000000 --- a/python/mknapsack/_algorithms_cy/mtm_cy.pyx +++ /dev/null @@ -1,20 +0,0 @@ -from libcpp.vector cimport vector - - -cdef extern from "mtm_c.h" namespace "mtm": - - cdef cppclass MTMSolver: - MTMSolver(vector[int], vector[int], vector[int], int, int) except + - vector[int] solve() - - -cdef class cyMTMSolver: - """Wrapper for the C++ code.""" - cdef MTMSolver *solver - - def __cinit__(self, vector[int] p, vector[int] w, vector[int] c, int max_bt, int max_time): - self.solver = new MTMSolver(p, w, c, max_bt, max_time) - - def solve(self): - cdef list res = self.solver.solve() - return res diff --git a/python/mknapsack/algorithms.py b/python/mknapsack/algorithms.py deleted file mode 100644 index f587331..0000000 --- a/python/mknapsack/algorithms.py +++ /dev/null @@ -1,111 +0,0 @@ -"""Algorithms for solving the Multiple Knapsack Problem.""" - - -from math import gcd -from functools import reduce - -import numpy as np -import pandas as pd - -try: - from mknapsack._algorithms_cy.mtm_cy import cyMTMSolver -except ModuleNotFoundError: - raise ImportError('Could not import module - most likely Cython / C++ ' - 'was not compiled properly') - - -def greatest_common_divisor(number): - return reduce(gcd, number) - - -def mtm(p, w, c, max_bt=-1, max_time=3600): - """Solves Multiple 0-1 Knapsack Problem with MTM algorithm. - - Args: - p (list): Item profits. - w (list): Item weights. - c (list): Knapsack capacities. - max_bt (int): Maximum number of backtracks to perform. Defaults to -1, - which is unlimited. - max_time (int): Number of seconds after which the best solution so far - is returned. Defaults to 3600. - - Returns: - Tuple of the following: - z (int): Total profit. - x (list): Assigned knapsacks for each item. Knapsack '-1' indicates - that the item is not assigned to any knapsack. - bt (int): Number of backtracks performed by the algorithm. - glopt (bool): Whether the given solution is guaranteed to be global - optimum or not. - - Raises: - ValueError, if inputs are of incorrect type or size. - - References: - S. Martello, P. Toth - A Bound and Bound algorithm for the zero-one multiple knapsack problem - Discrete Applied Mathematics, 3 (1981), pp. 257-288 - """ - # Validate inputs - if not all(isinstance(vec, list) for vec in [p, w, c]): - raise ValueError('All inputs are not of type "list"') - if len(p) != len(w): - raise ValueError('Profit and weight lengths are not equal' - f'({len(p)} != {len(w)})') - if not isinstance(max_bt, int): - raise ValueError('Parameter ``max_bt`` must of type "int"') - if not isinstance(max_time, int): - raise ValueError('Parameter ``max_time`` must of type "int"') - if max_time < 1: - raise ValueError('Parameter ``max_time`` must be positive') - - items = np.arange(len(p), dtype=int) - ksacks = np.arange(len(c), dtype=int) - - # Scale the problem - scale = greatest_common_divisor(w + c) - - # Decreasing profit/weight ratio for items - p_ar = np.array(p, dtype=int) - w_ar = np.array(w, dtype=int) / scale - pw_ord = np.argsort(p_ar / w_ar)[::-1] - pw_map = np.zeros(len(p), dtype=int) - pw_map[pw_ord] = items - - # Increasing capacity for knapsacks - c_ar = np.array(c, dtype=int) / scale - c_ord = np.argsort(c_ar) - c_map = dict((i, v) for i, v in enumerate(c_ord)) - c_map[-1] = -1 - - # Sort arrays - p_srt = p_ar[pw_ord].tolist() - w_srt = w_ar[pw_ord].tolist() - c_srt = c_ar[c_ord].tolist() - - # Solve - res = cyMTMSolver(p_srt, w_srt, c_srt, max_bt, max_time).solve() - x = np.array(res[:-3]) - glopt = res[-3] - z = res[-2] - bt = res[-1] - - # Sort items and knapsacks to their original order - x = [c_map[i] for i in x[pw_map]] - - # Ensure solution validity - x_ar = np.array(x) - df = pd.DataFrame({'i': x_ar, 'j': items, 'p': p_ar, 'w': w_ar * scale}) - df = df.merge(pd.DataFrame({'i': ksacks, 'c': c_ar * scale}), - on='i', how='left') - df['c'] = df['c'].fillna(-1).astype(int) - df = df.groupby('i').agg({'p': np.sum, 'w': np.sum, 'c': np.max}) - df['valid'] = (df['c'] >= df['w']).astype(int) - if z != df.loc[df.index >= 0, 'p'].sum(): - raise ValueError('Solution value not matching the profits of ' - 'chosen items') - if df['valid'].sum() != df.loc[df.index >= 0].shape[0]: - raise ValueError('Solution not valid:\n%s' % df) - - return z, x, bt, glopt diff --git a/python/tests/__init__.py b/python/tests/__init__.py deleted file mode 100644 index e69de29..0000000 diff --git a/python/tests/test_algorithms.py b/python/tests/test_algorithms.py deleted file mode 100644 index 10bb82c..0000000 --- a/python/tests/test_algorithms.py +++ /dev/null @@ -1,138 +0,0 @@ -"""Test cases for algorithms.""" - - -import pytest - -from mknapsack.algorithms import mtm # Compile the latest version inplace - - -@pytest.mark.parametrize( - 'params', - [ - { - 'p': [92, 57, 49, 68, 60, 43, 67, 84, 87, 72], - 'w': [23, 31, 29, 44, 53, 38, 63, 85, 89, 82], - 'c': [70, 127], - 'z': 333, - 'x': [0, 1, 1, 0, -1, -1, 1, -1, -1, -1] - }, - { - 'p': [110, 150, 70, 80, 30, 5], - 'w': [40, 60, 30, 40, 20, 5], - 'c': [65, 85], - 'z': 345, - 'x': [1, 0, -1, 1, -1, 0] - }, - { - 'p': [78, 35, 89, 36, 94, 75, 74, 79, 80, 16], - 'w': [18, 9, 23, 20, 59, 61, 70, 75, 76, 30], - 'c': [103, 156], - 'z': 452, - 'x': [0, -1, 0, 1, 1, 0, -1, -1, 1, -1] - }, - { - 'p': [78, 35, 89, 36, 94, 75, 74, 79, 80, 16], - 'w': [18, 9, 23, 20, 59, 61, 70, 75, 76, 30], - 'c': [76, 110, 112], - 'z': 503, - 'x': [1, 1, 1, 2, 1, 2, -1, -1, 0, 2] - }, - { - 'p': [78, 77, 35, 34, 33, 89, 88, 36, 35, 94, 93, 75, 74, 74, 73, - 79, 78, 80, 79, 16, 15, 10], - 'w': [18, 18, 9, 9, 9, 23, 23, 20, 20, 59, 59, 61, 61, 70, 70, - 75, 75, 76, 76, 30, 30, 40], - 'c': [80, 103, 109, 112], - 'z': 841, - 'x': None - }, - { - 'p': [78, 77, 35, 34, 89, 88, 36, 35, 94, 93, 75, 74, 74, 73, 79, - 78, 80, 79, 16, 15, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1], - 'w': [18, 18, 9, 9, 23, 23, 20, 20, 59, 59, 61, 61, 70, 70, 75, 75, - 76, 76, 30, 30, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49], - 'c': [80, 90, 100, 110], - 'z': 779, - 'x': None - }, - { - 'p': [78, 77, 35, 34, 33, 89, 88, 36, 35, 94, 93, 75, 74, 74, 73, - 79, 78, 80, 79, 16, 15, 10], - 'w': [18, 18, 9, 9, 9, 23, 23, 20, 20, 59, 59, 61, 61, 70, 70, - 75, 75, 76, 76, 30, 30, 40], - 'c': [112, 109, 80, 103], - 'z': 841, - 'x': None - }, - { - 'p': [78, 77, 35, 34, 33, 89, 88, 36, 35, 94, 93, 75, 74, 74, 73, - 79, 78, 80, 79, 16, 15, 10], - 'w': [18, 18, 9, 9, 9, 23, 23, 20, 20, 59, 59, 61, 61, 70, 70, - 75, 75, 76, 76, 30, 30, 40], - 'c': [20, 40, 60, 80, 100], - 'z': 708, - 'x': None - }, - { - 'p': [78, 77, 35, 34, 33, 89, 88, 36, 35, 94, 93, 75, 74, 74, 73, - 79, 78, 80, 79, 16, 15, 10], - 'w': [18, 18, 9, 9, 9, 23, 23, 20, 20, 59, 59, 61, 61, 70, 70, - 75, 75, 76, 76, 30, 30, 40], - 'c': [20, 30, 35, 40, 45, 100], - 'z': 615, - 'x': None - }, - { - 'p': [63, 66, 65, 64, 64, 64, 64, 63, 64, 65, 3, 3, 3, 4, 4, 4, 5, - 5, 5, 6, 6, 6], - 'w': [420, 510, 510, 420, 420, 390, 420, 510, 420, 510, 270, 300, - 330, 360, 390, 420, 450, 480, 510, 540, 570, 600], - 'c': [1320, 1320, 1320, 1320], - 'z': 649, - 'x': None - }, - { - 'p': [63, 66, 65, 64, 64, 64, 64, 63, 64, 65, 3, 3, 3, 4, 4, 4, 5, - 5, 5, 6, 6, 6], - 'w': [420, 510, 510, 420, 420, 390, 420, 510, 420, 510, 270, 300, - 330, 360, 390, 420, 450, 480, 510, 540, 570, 600], - 'c': [1320, 1320, 1320, 1320], - 'z': 649, - 'x': None - }, - { - 'p': [1, 1], - 'w': [1, 1], - 'c': [2, 2], - 'z': 2, - 'x': None - } - ] -) -def test_mtm(params): - expected_z = params.pop('z') - expected_x = params.pop('x') - z, x, bt, _ = mtm(**params) - assert z == expected_z - if expected_x: - assert x == expected_x - - -def test_mtm_fail(): - # ValueError, when non-equal length - try: - mtm(p=[1, 2, 3, 4], w=[1, 5], c=[5]) - assert False - except ValueError: - assert True - except Exception: - assert False - - # Non-list inputs - try: - mtm(p=[1, 2, 3, 4], w=[1, 5], c=5) - assert False - except ValueError: - assert True - except Exception: - assert False diff --git a/requirements-dev.txt b/requirements-dev.txt index ea442bf..6cf9707 100644 --- a/requirements-dev.txt +++ b/requirements-dev.txt @@ -1,2 +1,7 @@ -pytest==5.4.2 -twine \ No newline at end of file +flake8==4.0.1 +numpy==1.23.1 +pytest==7.1.2 +setuptools==63.2.0 +setuptools-scm==7.0.5 +twine==4.0.1 +wheel==0.37.1 \ No newline at end of file diff --git a/requirements.txt b/requirements.txt index 702fd1c..1a118f8 100644 --- a/requirements.txt +++ b/requirements.txt @@ -1,3 +1,2 @@ -cython>=0.26.1 -numpy>=1.13.3 -pandas>=0.20.3 \ No newline at end of file +numpy==1.23.1 +pandas==1.4.3 \ No newline at end of file diff --git a/setup.cfg b/setup.cfg deleted file mode 100644 index 224a779..0000000 --- a/setup.cfg +++ /dev/null @@ -1,2 +0,0 @@ -[metadata] -description-file = README.md \ No newline at end of file diff --git a/setup.py b/setup.py index 6bcaf24..c0d8150 100644 --- a/setup.py +++ b/setup.py @@ -1,49 +1,15 @@ -from setuptools import Extension, setup +from numpy.distutils.core import setup, Extension -with open('README.md', 'r') as f: - long_description = f.read() +ext_modules = [ + Extension( + name='mknapsack._algos', + sources=['mknapsack/_algos.f'], + extra_f77_compile_args=['-std=legacy'], + f2py_options=['--quiet'], + ) +] -with open('VERSION', 'r') as f: - version = f.read().strip() -ext_modules = [] -ext_modules += [Extension( - "mknapsack._algorithms_cy.mtm_cy", - sources=["cpp/mtm_c.cpp", "python/mknapsack/_algorithms_cy/mtm_cy.pyx"], - include_dirs=['cpp/'], - language='c++', - extra_compile_args=["-std=c++1y"] -)] - -setup( - name='mknapsack', - version=version, - license='MIT', - description='Algorithms for Multiple Knapsack Problem (MKP)', - long_description=long_description, - long_description_content_type='text/markdown', - author='Jesse Myrberg', - author_email='jesse.myrberg@gmail.com', - url='https://github.com/jmyrberg/mknapsack', - keywords=['algorithm', 'multiple', 'knapsack', 'optimization'], - setup_requires=[ - 'cython>=0.26.1' - ], - install_requires=[ - 'cython>=0.26.1', - 'numpy>=1.13.3', - 'pandas>=0.20.3' - ], - packages=['mknapsack', 'mknapsack._algorithms_cy'], - package_dir={ - 'mknapsack': 'python/mknapsack', - }, - ext_modules=ext_modules, - classifiers=[ - 'Development Status :: 5 - Production/Stable', - 'Programming Language :: Python :: 3', - 'Intended Audience :: Developers', - 'License :: OSI Approved :: MIT License' - ] -) +if __name__ == '__main__': + setup(ext_modules=ext_modules) diff --git a/python/mknapsack/__init__.py b/tests/__init__.py similarity index 100% rename from python/mknapsack/__init__.py rename to tests/__init__.py diff --git a/tests/test__multiple.py b/tests/test__multiple.py new file mode 100644 index 0000000..f6837c1 --- /dev/null +++ b/tests/test__multiple.py @@ -0,0 +1,227 @@ +"""Test cases for algorithms.""" + + +import pandas as pd +import pytest + +from mknapsack._multiple import solve_multiple_knapsack +from mknapsack._exceptions import FortranInputCheckError + + +multiple_knapsack_case_small = { + 'case': 'small', + 'profits': [78, 35, 89, 36, 94, 75, 74, 100, 80, 16], + 'weights': [18, 9, 23, 20, 59, 61, 70, 75, 76, 30], + 'capacities': [90, 100], + 'total_profit': 407, + 'solution': [2, 1, 2, 1, 2, 1, 0, 0, 0, 0] +} + +multiple_knapsack_case_medium = { + 'case': 'medium', + 'profits': [78, 35, 89, 36, 94, 75, 74, 100, 80, 16] * 5, + 'weights': [18, 9, 23, 20, 59, 61, 70, 75, 76, 30] * 5, + 'capacities': [90, 100] * 2, + 'total_profit': 1213, + 'solution': [1, 0, 3, 0, 0, 0, 0, 0, 0, 0, 3, 4, 2, 2, 4, 0, 0, 0, 0, 0, 3, + 2, 4, 1, 0, 0, 0, 0, 0, 0, 2, 4, 3, 2, 0, 0, 0, 0, 0, 0, 3, 1, + 1, 1, 0, 0, 0, 0, 0, 0] +} + +multiple_knapsack_case_large = { + 'case': 'large', + 'profits': [78, 35, 89, 36, 94, 75, 74, 100, 80, 16] * 100_000, + 'weights': [18, 9, 23, 20, 59, 61, 70, 75, 76, 30] * 100_000, + 'capacities': [90, 100] * 500, + 'total_profit': None, # We just want some solution + 'solution': None +} + +multiple_knapsack_success_cases = [ + { + 'method': 'mtm', + **multiple_knapsack_case_small, + }, + { + 'method': 'mtm', + **multiple_knapsack_case_small, + 'verbose': True + }, + { + 'method': 'mtm', + **multiple_knapsack_case_medium, + }, + { + 'method': 'mtm', + 'method_kwargs': {'max_backtracks': 20}, + **multiple_knapsack_case_small, + 'tolerance': 0.97 + }, + { + 'method': 'mthm', + **multiple_knapsack_case_small + }, + { + 'method': 'mthm', + 'method_kwargs': {'call_stack': 0}, + **multiple_knapsack_case_small, + 'tolerance': 0.85 + }, + { + 'method': 'mthm', + **multiple_knapsack_case_medium, + 'tolerance': 0.97 + }, + { + 'method': 'mthm', + **multiple_knapsack_case_large, + 'tolerance': None + } +] + +multiple_knapsack_fail_cases_base = [ + { + 'case': 'profit_weight_mismatch', + 'methods': ['mtm', 'mthm'], + 'profits': [1, 2, 3, 4, 5], + 'weights': [1, 2, 3, 4], + 'capacities': [2, 7], + 'fail_type': ValueError + }, + { + 'case': 'only_one_item', + 'methods': ['mtm', 'mthm'], + 'profits': [1], + 'weights': [1], + 'capacities': [10], + 'fail_type': FortranInputCheckError + }, + { + 'case': 'too_many_items', + 'methods': ['mtm'], + 'profits': [1] * 1001, + 'weights': [1] * 1001, + 'capacities': [10], + 'fail_type': ValueError + }, + { + 'case': 'no_knapsacks', + 'methods': ['mtm', 'mthm'], + 'profits': [1, 2, 3, 4, 5], + 'weights': [1, 2, 3, 4, 5], + 'capacities': [], + 'fail_type': FortranInputCheckError + }, + { + 'case': 'too_many_knapsacks', + 'methods': ['mtm'], + 'profits': [1, 2, 3, 4, 5], + 'weights': [1, 2, 3, 4, 5], + 'capacities': [4] * 11, + 'fail_type': ValueError + }, + { + 'case': 'profit_lte_0', + 'methods': ['mtm', 'mthm'], + 'profits': [1, 2, 3, 4, 0], + 'weights': [1, 2, 3, 4, 5], + 'capacities': [2, 7], + 'fail_type': FortranInputCheckError + }, + { + 'case': 'weight_lte_0', + 'methods': ['mtm', 'mthm'], + 'profits': [1, 2, 3, 4, 5], + 'weights': [1, 2, 3, 4, 0], + 'capacities': [2, 7], + 'fail_type': FortranInputCheckError + }, + { + 'case': 'capacity_lte_0', + 'methods': ['mtm', 'mthm'], + 'profits': [1, 2, 3, 4, 0], + 'weights': [1, 2, 3, 4, 5], + 'capacities': [2, 0], + 'fail_type': FortranInputCheckError + }, + { + 'case': 'min_weight_gt_max_capacity', + 'methods': ['mtm', 'mthm'], + 'profits': [1, 2, 3, 4, 5], + 'weights': [8, 9, 10, 11, 12], + 'capacities': [2, 7], + 'fail_type': FortranInputCheckError + }, + { + 'case': 'max_weight_gt_min_capacity', + 'methods': ['mtm', 'mthm'], + 'profits': [1, 2, 3, 4, 5], + 'weights': [1, 2, 3, 4, 5], + 'capacities': [4], + 'fail_type': FortranInputCheckError + }, + { + 'case': 'total_weight_le_min_capacity', + 'methods': ['mtm', 'mthm'], + 'profits': [1, 2, 3, 4, 5], + 'weights': [1, 2, 3, 4, 5], + 'capacities': [16], + 'fail_type': FortranInputCheckError + } +] +multiple_knapsack_fail_cases = [ + {**case, 'method': method} + for case in multiple_knapsack_fail_cases_base + for method in case['methods'] +] + + +def get_id(params): + method = str(params.get('method', 'NotSet')) + method_kwargs = str(params.get('method_kwargs', 'NotSet')) + case = str(params.get('case', 'NotSet')) + verbose = str(params.get('verbose', 'NotSet')) + return f'{method}-{method_kwargs}-{verbose}-{case}' + + +@pytest.mark.parametrize('params', multiple_knapsack_success_cases, ids=get_id) +def test_solve_multiple_knapsack(params): + func_kwargs = dict( + profits=params['profits'], + weights=params['weights'], + capacities=params['capacities'] + ) + for opt_param in ['method', 'method_kwargs', 'verbose']: + if opt_param in params: + func_kwargs[opt_param] = params[opt_param] + + res = solve_multiple_knapsack(**func_kwargs) + + assert isinstance(res, pd.DataFrame) + assert len(res) == len(params['profits']) + + total_profit = params['total_profit'] + solution = params['solution'] + tolerance = params.get('tolerance', 1) + + # Ensure profit within given limits + if total_profit is not None: + min_allowed_profit = tolerance * total_profit + test_total_profit = res.query('assigned')['profit'].sum() + if tolerance == 1: + assert test_total_profit == min_allowed_profit + else: + assert test_total_profit >= min_allowed_profit + + # Ensure global optimum when tolerance = 1 + if solution is not None and tolerance == 1: + test_solution = tuple(res['knapsack_id'].to_list()) + assert tuple(solution) == test_solution + + +@pytest.mark.parametrize('params', multiple_knapsack_fail_cases, ids=get_id) +def test_solve_multiple_knapsack_fail(params): + del params['case'], params['methods'] + fail_type = params.pop('fail_type') + with pytest.raises(fail_type): + solve_multiple_knapsack(**params)