program processorEfficientHypercubeAlgorithmsForTheKnapsackProblem; (*{{{ documentation*) (* Taken from the work Processor Efficient Hypercube Algorithms for the Knapsack Problem by Jianhua Lin and James A. Storer. published in the Journal of Parallel and Distributed Computing 11, 332-337 (1991). Department of Computer Science, Brandeis University, Waltham, Massachusetts 02254. *) (*}}} *) (*{{{ const, types and variables*) const max = 8; maxDiv2 = 4; type vector = array [0..max] of integer; smallVector = array [0..maxDiv2] of integer; matrix = array [0..maxDiv2] of smallVector; var n : integer; (* number of processors *) m : integer; (* number of objects *) c : integer; (* capacity *) d : integer; (* number of components of F[j][c] assigned *) (* to each processor *) w : vector; (* weights *) p : vector; (* profits *) f : matrix; (* be careful, this matrix may cause an stack *) (* overflow *) b : matrix; (*}}} *) procedure readData; (*{{{ body of readData*) begin (*{{{ documentation*) writeln(' '); writeln('This program solves the Knapsack Problem using an algorithm'); writeln('Taken from the work '); writeln('Processor Efficient Hypercube Algorithms for the Knapsack '); writeln('Problem, by Jianhua Lin and James A. Storer. '); writeln('published in the Journal of Parallel and Distributed Compu-'); writeln('ting 11, 332-337 (1991). '); writeln('Department of Computer Science, Brandeis University, '); writeln(' Waltham, Massachusetts 02254. '); writeln(' '); (*}}} *) repeat write('number of objects: '); read(m); until (m > 0) and (m <= max); repeat write('capacity: '); read(c); until (c <= max); var i : integer; begin for i := 1 to m do repeat write('weight profit ',i,': '); read(w[i]); read(p[i]); until (w[i] > 0) and (p[i] > 0); end (* var i *); repeat write('number of processors: '); read(n); until (n > 0) and (n <= maxDiv2); end; (*}}} *) procedure writeSolution(i,j, step : integer); (*{{{ body of writeSolution*) var capacity : integer; begin if (step > 0) then begin if (b[i][j] AND (&step)) = &step then begin write(' ',step); capacity := i*d+j-w[step]; writeSolution(capacity div d,capacity mod d,step-1); end else writeSolution(i,j,step-1); end; end (* writeSolution *); (*}}} *) procedure writeData(step : integer); (*{{{ body of writeData*) var i, j, k : integer; begin write('step ',step); (*{{{ write array f[i][j] i = 0,..,n j = 0,..,d-1*) i := 0; while (i < n) do begin j := 0; while j < d do begin write('f[',i,'][',j,'] = ',f[i][j],' '); j := j+1; end; writeln; i := i+1 end; (*}}} *) (*{{{ write sets b[i][j] i = 0,..,n j = 0,..,d-1*) i := 0; while (i < n) do begin j := 0; while j < d do begin write('sol for ',i,',',j,': {'); writeSolution(i,j,step); write(' } '); j := j+1; end; writeln; i := i+1 end; (*}}} *) write('Press to continue ... '); readln; end (* writeData *); (*}}} *) procedure LinAndStorer( n : integer; (* number of processors *) m : integer; (* number of objects *) c : integer; (* capacity *) var d : integer; (* size of the subinterval assigned to *) (* to each processor *) var w : vector; (* weights *) var p : vector; (* profits *) var f : matrix; (* optimal profits *) var b : matrix (* set solution *) ); (*{{{ body of LinAndStorer(n,m,c,d,w,p,f,b)*) (*{{{ comments*) (* f[name][i] represents the optimal value for a knapsack of *) (* capacity: name*d+i, where name = 0,..,n and i = 0,..,d-1 *) (* the following recursive formula helds *) (* f[name][i] := max {f[name][i], f[name][i-w[j]]+p[j]} *) (* where name*d+i > w[j] *) (* that is, name*d > w[j] - i *) (* processor name is in charge of the subinterval of capacities*) (* name*d...(name+1)*d-1=name*d+d-1 *) (*}}} *) begin (*{{{ d := closest integer to (c+1)/n that is greater than (c+1)/n*) d := (c+1) div n; if ((c+1) mod n) <> 0 then d := d+1; (*}}} *) writeln('d = ',d); parallel 0..n-1 do (*{{{ f[name][i] := 0 for i = 0,1,...,d-1*) var i : integer; begin i := 0; while (i < d) do begin f[name][i] := 0; b[name][i] := 0; i := i+1; end; end (* parallel *); (*}}} *) writeData(0); var j : integer; begin (* for each family of objects from object 1 to object j *) j := 1; (* with j = 1,..,m *) while j <= m do (*{{{ compute f[name][i] name = 0,..,n and i = 0,..,d-1 the optimal value*) var i, first : integer; begin i := 0; while i <= d-1 do (* each processor computes f[name][i] = f[name*d+i] *) begin (*{{{ first := max {(w[j]-i) div d, 0}*) first := (w[j]-i) div d; if ((w[j] - i) mod d) > 0 then first := first+1; (*}}} *) parallel first..n-1 do (*{{{ f:=max{f[name][i], f[name*d+i-w[j]/d][name*d+i-w[j] mod d]+p[j]*) var s,t,value : integer; begin t := name*d+i-w[j]; s := t div d; t := t mod d; value := f[s][t]+p[j]; if f[name][i] < value then begin f[name][i] := value; b[name][i] := b[name][i] OR (&j); end; end; (*}}} *) i := i+1; end (* while i *) ; writeData(j); j := j+1; end (* while j *); (*}}} *) end (* var j *); end (* Lin *); (*}}} *) begin readData; LinAndStorer(n,m,c,d,w,p,f,b); end.