home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / languags / modula2 / selectio.mod < prev    next >
Text File  |  1987-01-08  |  2KB  |  86 lines
  1. (* Find an optimal selection of objects from a given set of n objects
  2.    under a given constraint.  Each object is characterised by two
  3.    properties v (for value) and w (for weight).  The optimal selection
  4.    is the one with the largest sum of values of its members.  The
  5.    constraint is that the sum of their weights must not surpass
  6.    a given limit limv.  The algorithm is called branch and bound. *)
  7.  
  8. MODULE selection;
  9.  
  10. FROM InOut IMPORT WriteString, WriteCard, ReadCard, WriteLn, Write;
  11.  
  12. CONST n = 10;
  13.  
  14. TYPE index = [1..n];
  15.      object = RECORD
  16.                 v,w: CARDINAL
  17.               END;
  18.      soi = SET OF index;
  19.  
  20. VAR i: index;
  21.     a: ARRAY index OF object;
  22.     limw,totv,maxv,w1,w2,w3: CARDINAL;
  23.     s,opts: soi;
  24.     z: ARRAY [0..1] OF CHAR;
  25.  
  26. PROCEDURE try(i: index; tw,av: CARDINAL);
  27. VAR av1: CARDINAL;
  28.  
  29. BEGIN
  30.   IF tw + a[i].w <= limw THEN
  31.     INCL(s,i);
  32.     IF i < n THEN
  33.       try(i+1,tw+a[i].w,av)
  34.     ELSE
  35.       IF av > maxv THEN
  36.         maxv := av;
  37.         opts := s
  38.       END;
  39.       EXCL(s,i)
  40.     END
  41.   END;
  42.   av1 := av - a[i].v;
  43.   IF av1 > maxv THEN
  44.     IF i < n THEN
  45.       try(i+1,tw,av1)
  46.     ELSE
  47.       maxv := av1;
  48.       opts := s
  49.     END
  50.   END
  51. END try;
  52.  
  53. BEGIN
  54.   totv := 0;
  55.   FOR i := 1 TO n DO
  56.     WITH a[i] DO
  57.       WriteString(' Enter the value> '); ReadCard(v);
  58.       WriteString(' Enter the weight> '); ReadCard(w);
  59.       WriteLn;
  60.       totv := totv + v
  61.     END
  62.   END;
  63.   WriteString(' Enter weights 1, 2, 3 > ');
  64.   ReadCard(w1); ReadCard(w2); ReadCard(w3);
  65.   WriteLn;
  66.   z[0] := '*'; z[1] := ' ';
  67.   WriteLn; WriteString(' weight > ');
  68.   FOR i := 1 TO n DO WriteCard(a[i].w,4) END;
  69.   WriteLn; WriteString(' value> ');
  70.   FOR i := 1 TO n DO WriteCard(a[i].v,4) END;
  71.   WriteLn;
  72.   REPEAT
  73.     limw := w1;
  74.     maxv := 0;
  75.     s := soi{}; opts := soi{};
  76.     try(1,0,totv);
  77.     WriteCard(limw,6);
  78.     FOR i := 1 TO n DO
  79.       WriteString('  ');
  80.       IF i IN opts THEN Write(z[0]) ELSE Write(z[1]) END;
  81.     END;
  82.     WriteLn;
  83.     w1 := w1 + w2;
  84.   UNTIL w1 > w3
  85. END selection.
  86.