Sample Modules

Atanas Radenski
Computer Science Department, P.O. Box 19479
Winston-Salem State University, Winston-Salem, NC 27103
e-mail: radenski@computer.org


Here we present a sample generic parallel algorithm for probabilistic computations. We use this generic algorithm to derive a specific parallel algorithm for a popular discrete optimization problem, the knapsack problem.

< ^>    Contents

1. Introduction
2. Generic Parallel Probabilistic Algorithm
3. Derivation of  a Parallel Knapsack Algorithms
4. Related Links

< ^>    1. Introduction

Probabilistic algorithms, such as Monte-Carlo trials, genetic algorithms, hill-climbing, and simulated annealing, are approximate methods for intractable problems, i.e., problems for which no efficient exact algorithms are believed to exist. The knapsack problemis an example of an intractable discrete optimization problems for which probabilistic algorithms seem promising.

A typical probabilistic algorithm tries to approximately solve a problem with a vast number of potential solutions by first generating a smaller set of candidate solutions. Then, the algorithm tries to improve the set of candidate solution by means of some probabilistic computations, such as simulated annealing, hill-climbing, cross-over, or Monte-Carlo trials. Such probabilistic computations can be very intensive yet highly independent for the individual candidate solutions. As a consequence, a cluster of workstations can efficiently perform probabilistic computations with little coordination between the processors.

It is possible to specify a common parallel control structure as a generic parallel algorithm for probabilistic computations. Such a generic algorithm implements process control and communication in a problem-independent manner. The generic parallel algorithm can be glued together with domain-specific sequential-only algorithms in order to derive approximate parallel solutions for different intractable problems.

<^> 2. Generic Parallel Probabilistic Algorithm

We assume that a problem is defined by the type of its solution and by three sequential methods: a method to improve individual candidate solutions;
a method to test if a set of candidate solutions contain an acceptable approximation;
a method to generate a new set of candidate solutions for further exploration.
The algorithm maintains a set s of n candidate solutions and tries to improve them by means of one master and p server processes. The master is connected to each server with a two-way communication channel. The master process sends l = n divp candidate solution to each server. The servers probabilistically improve their assigned candidate solutions in parallel and then send the improved versions back to the master. The master tests the set of current solutions and, if no more improvements are needed, terminates the servers and itself. Alternatively, if further improvements are needed, the master generates a new set of candidate solutions and again sends them to the servers.

We specify this generic master-server algorithm as a module MS using the parallel language Paradigm/SP.
 

module MS;
{probabilistic master-server}

const
  solLimit* = 10;
type
  domain* = class
    generations*: integer;
  end;
  solution* = ..;
  set* =
    array[1..solLimit] of solution;
  population* =
    class
      s*: set;
      popSize*: integer;
    end;
  channel = *(domain, solution);
  net = array [1..solLimit] of channel;

procedure climb*(
  d: domain;
  var s: solution);
begin end;

procedure recombine*(
  d: domain;
  var p: population);
begin end;

procedure setBest*(
  var p: population);
begin end;

procedure server(
  c: channel);
var
  d: domain; s: solution;
  i: integer;
begin
{  writeln('server started...');}
  receive(c, d);
  for i := 1 to d.generations do
    begin
      receive(c, s);
      climb(d, s);
      send(c, s);
    end;
end;

procedure master(c: net;
  d: domain;
  var p: population);
var
  i, g: integer;
begin
  writeln('master started...');
  for i := 1 to p.popSize do
    send(c[i], d);
  for g := 1 to d.generations do
    begin
      for i := 1 to p.popSize do
        send(c[i], p.s[i]);
      for i := 1 to p.popSize do
        receive(c[i], p.s[i]);
      setBest(p);
      recombine(d, p);
    end;
end;

procedure PHCC-(d: domain;
  var p: population);
var c: net;
  i: integer;
begin
  for i := 1 to p.popSize do
    open(c[i]);
  [sic]parallel
    master(c, d, p) |
    forall i := 1 to p.popSize do
      server(c[i])
  end
end;

begin
  writeln('MS loaded');
end.

<^>  3. Derivation of a Parallel Knapsack Algorithm

We use the generic master-server algorithm to derive a parallel algorithmfor the knapsack problem. We achieve this by defining the specific type of solution for the knapsack problem, and by defining concrete sequential versions of methods improve, test, and generate. More specifically, we represent candidate solutions as binary chromosomes and define method improve to perform extensive hill-climbing on a number of replicas of each chromosome.

We specify this parallel knapsack algorithm using Paradigm/SP.  The derivation is programmed by means of module extension and consitst of the following modules:
 
 

 
 
 
 
 
 
 

{......................}

bullet Randoms: Random number generation
bullet Sol: Solution representation
bullet Pop: Population representation
bullet Knap: Knapsack solver
bullet Main: Main module

module Randoms;
  procedure probab*(var p: real);
  begin
    p := random(1000) / 1000.0;
  end;

  procedure index*(var ind: integer;
                   low, high: integer);
  begin
    ind := random(high-low+1) + low;
  end;
begin
  writeln('Randoms loaded');
end.

{......................}

module Sol(MS);
import Randoms;

const
  probLimit*   = 40;   { largest possible solution         }
  climbLimit* = 10;   { largest possible number of climbers }

type
  bitArray* = array[1..probLimit] of boolean;
  solution* = class
    bit*: bitArray;
    fitness*: real;
  end;
  domain* =
    class
      solSize*: integer;
      onesProbab*: real;
      nofClimbers*: integer;
      maxAttempts*: integer;
    end;

{ methods }

procedure evaluate*(
  d: domain;
  var s: solution);
{ abstract fitness function,
  must be defined in an application }
begin end;

procedure newSol*(
  d: domain;
  var s: solution
);
var k: integer; r: real;
begin
  for k := 1 to d.solSize do
    begin
      Randoms.probab(r);
      if r <= d.onesProbab then s.bit[k] := true
      else s.bit[k] := false;
    end;
  evaluate(d, s);
end;

procedure climb*(
  d: domain;
  var s: solution);
type
  climbersArray =
    array[1..climbLimit] of solution;
var
  climbers: climbersArray;
  i, k, failed: integer;
  climbing: boolean;
begin
  failed := 0;
  for i := 1 to d.nofClimbers do
    climbers[i] := s;
  while failed < d.maxAttempts do
    begin
      climbing := false;
      for i := 1 to d.nofClimbers do
        begin
{         mutate climbers[i] at location k;  }
          Randoms.index(k, 1, d.solSize);
          climbers[i].bit[k] := not climbers[i].bit[k];
          evaluate(d, climbers[i]);
          if s.fitness < climbers[i].fitness then
            begin
              s := climbers[i];
              climbing := true;
            end;
        end;
      if climbing then
        begin
          failed := 0;
          for i := 1 to d.nofClimbers do
            climbers[i] := s;
        end
      else
        failed := succ(failed);
    end;
end;

procedure crossover*(
  d: domain;
  var s, s1: solution);
{ perform in place, w/o creating a new solution }
var
  recombLocation, k: integer;
  save: boolean;
begin
  { swap genes between solutions s and s1
    at a randomly calculated crossover position:
  }

  Randoms.index(recombLocation,
    2, d.solSize-1);
  for k := 1 to recombLocation do
    begin
      save := s.bit[k];
      s.bit[k] := s1.bit[k];
      s1.bit[k] := save;
    end;
  evaluate(d, s);
  evaluate(d, s1);
end;

procedure printSol-(
  d: domain;
  s: solution);
var
  i: integer;
begin
  for i := 1 to d.solSize do begin
    write(ord(s.bit[i]):2);
    if (i mod 20) = 0 then writeln
  end;
end;

begin { sol }
  writeln('Sol loaded')
end.

{......................}

module Pop(Sol);
import Randoms;

type
  population* =
    class
      currentBest*: solution;
    end;

procedure setBest*(
  var p: population);
var i: integer;
begin
  for i := 1 to p.popSize do
    if p.currentBest.fitness < p.s[i].fitness then
      p.currentBest := p.s[i];
end;

procedure setPopul*(
  var d: domain;
  var p: population);
var i: integer;
begin
  for i := 1 to p.popSize do
    newSol(d, p.s[i]);
  p.currentBest := p.s[1];
  setBest(p);
end;

procedure permute*(
  var p: population);
type
  tagArray = array[1..solLimit] of boolean;
var
  i, k, offset: integer;
  solutionsToPermute: integer;
  s: solution;
  tagged: tagArray;

begin
  solutionsToPermute := p.popSize;
  for i := 1 to p.popSize do
    tagged[i] := false; { all initially untagged }
  i := 1;
  while solutionsToPermute > 1 do
    begin
      { determine first solution to cross-over }
      while tagged[i] do i := i + 1;
      tagged[i] := true;
      solutionsToPermute := solutionsToPermute - 1;
      { determine second solution to cross-over }
      Randoms.index(offset, 1, solutionsToPermute);
      k := i + offset;
      while tagged[k] do k := k + 1;
      tagged[k] := true;
      solutionsToPermute := solutionsToPermute - 1;
      s := p.s[i];
      p.s[i] := p.s[k];
      p.s[k] := s;
    end;
end;

procedure recombine*(
  d: domain;
  var p: population
);
  var i: integer;
begin
  begin
    permute(p);
    i := p.popSize;
    while i > 1 do
      begin
        [sic] crossover(
          d,
          p.s[i],
          p.s[i-1]
        );
        i := i-2;
      end;
  end;

end;

begin { population }
  writeln('Pop loaded');
end.

{......................}

module Knap(Pop);
import Randoms;

{parallel knapsack based on the hiearchy
 aPMS > dChromo > dPopul >dKnapsak}

const
  maxValue =  2; { v }
  maxRange =  1; { r }
type
  numericArray = array [1..solLimit] of integer;
  domain* =
    class
      capacity*: integer;
      weight*, profit*: numericArray;
    end;

procedure evaluate*(
  d: domain;
  var s: solution);
const
  lowFitness = 0;
var k, we, pr: integer;
begin
  we := 0; pr := 0;
  for k := 1 to d.solSize do
    if s.bit[k] then begin
      pr := pr + d.profit[k];
      we := we + d.weight[k];
    end;
  if we > d.capacity then pr := lowFitness;
  s.fitness := pr;
end;

procedure setParameters(
  var d: domain);
var k: integer;
  f: real;
begin
  for k := 1 to d.solSize do
    begin
      Randoms.index(d.weight[k], 1, maxValue);
      d.profit[k] := d.weight[k] + maxRange;
    end;
  d.capacity := 0;
  for k := 1 to d.solSize do
    d.capacity := d.capacity + d.weight[k];
  d.capacity := d.capacity div 2;
  {population onesProbab}
  f := 0.0;
  for k := 1 to d.solSize do
    f := f + d.weight[k];
  d.onesProbab := d.capacity / f;
end;

procedure setKnapsak-(
  var d: domain;
  var p: population);
var k: integer;
begin
  writeln('strongly correlated average 0/1 knapsack domain');
  writeln;
  write('problemSize: ':40); readln(d.solSize);
  assume((d.solSize > 0) and
    (d.solSize <= solLimit));
  write('populationSize: ':40); readln(p.popSize);
  assume((p.popSize > 0) and
    (p.popSize <= solLimit));
  write('generations: ':40); readln(d.generations);
  assume(d.generations > 0);
  write('maxAttempts: ':40); readln(d.maxAttempts);
  assume(d.maxAttempts > 0);

  d.nofClimbers :=  d.solSize div 4;
  assume((d.nofClimbers > 0) and
    (d.nofClimbers <= climbLimit));

  setParameters(d);

  setPopul(d, p);

  writeln('onesProbability: ':40 , d.onesProbab:1:3);
  writeln('initial fitness: ':40, p.currentBest.fitness:1:2);
  writeln;
  writeln('starting ', d.generations:1, ' generations...');
end;

procedure displayKnapsak-
  (d: domain;
   p: population);
var k: integer;
begin
  writeln('capacity: ':20, d.capacity);
  write('weights: ':20);
  for k := 1 to d.solSize do
    write(d.weight[k]:2);
  writeln;
  write('profits: ':20);
  for k := 1 to d.solSize do
    write(d.profit[k]:2);
  writeln;
  write('solution: ':20);
  printSol(d, p.currentBest);
  writeln('final fitness: ':20, p.currentBest.fitness:1:2);
  writeln;
end;

procedure run-;
var d: domain;
  p: population;
begin
  setKnapsak(d, p);
  PHCC(d, p);
  displayKnapsak(d, p);
end;

begin { knapsack }
  writeln('Knap loaded');
end.

{......................}

module Main(Knap);
begin
  writeln('Main loaded');
  run;
end.

<^ >    4. Related Links

*Index of Manuals
*The Paradigm Language and Its Implementation
*Research
*Contact

 

 

-------------
Last updated: October 1999.