program packing;

var fo:text;
var total:longint;

type
  largeray = array [0..pred($FFFF div sizeof(word))] of word;
  longlargeray = array [0..pred($FFFF div sizeof(longint))] of longint;

function knapsack(
  const items,
        values:  array of word;
  var   selection,
        maxsack: array of word
  ): longint;
{ Select from a number of items in order to maximize the sum of the value }
{ of the selected items, such that each item fits into one of a number    }
{ of bins, and that the capacity of each bin is not exceeded.  Returns    }
{ the maximum value selected.  The assignment of items to bins is stored  }
{ in the "selection" array, with "0" indicating that the item is not      }
{ stored in any bin.                                                      }

{ where                                                                   }
{   ITEMS = the size of each individual items                             }
{   VALUES = the value of each individual items                           }
{   SELECTION = returns the bin that each item is assignment to get the   }
{     the highest maximum value.                                          }
{   MAXSACK = contains the capacity of each bin                           }
var
  value, maxvalue: longint;
  saved: ^largeray;
  accum: ^longlargeray;

  procedure choose( x: word);
  { try storing item x into each of the bins.  Then, try storing the }
  { remaining items without selecting x at all                       }

    procedure saveselection;
    { remembers the current assignment }
    begin move(selection,saved^,succ(high(items))*sizeof(items[0])); end;

  var first: word;

    procedure setfirst;
    var j:word;
    begin
      first:=high(maxsack)+1;
      for j:=x-1 to high(items) do
        if (values[j]=values[x]) and (items[j]=items[x]) then begin
          if selection[j]<>0 then first:=selection[j]-1;
          exit; end;
    end;

  var y: word;

    function testexcess:boolean;
    var j:word;
    begin
      testexcess:=false;
      for j:=0 to y-1 do if maxsack[y]=maxsack[j] then exit;
      testexcess:=true;
    end;

  begin
    { don't bother continuing this direction if we couldn't find a      }
    { better solution even if all of the remaining items were selected. }
    if (accum^[x]+value)<=maxvalue then exit;
    { try storing the item in each bin }
    setfirst;
    for y:=first to high(maxsack) do
      if (items[x]<=maxsack[y]) and testexcess then begin
        selection[x]:=y+1; inc(value,values[x]); dec(maxsack[y],items[x]);
        { if we have a better solution, save it for recall later }
        if value>maxvalue then begin maxvalue:=value; saveselection; end;
        { if this isn't the last item, try storing the rest }
        if x<>0 then choose(x-1);
        { restore the bin state to what it was before we stored the item }
        inc(maxsack[y],items[x]); dec(value,values[x]); end;
    { if this isn't the last item, trying storing the rest and not this one }
    selection[x]:=0; if x<>0 then choose(x-1);
  end;

  function prerequisites:boolean;
  { the values and selection arrays must have at least as many elements }
  { as the items array.                                                 }
  begin
    prerequisites:=
      (high(items)<=high(values)) and (high(items)<=high(selection));
  end;

  procedure restoreselection;
  begin move(saved^,selection,succ(high(items))*sizeof(items[0])); end;

  procedure setaccum;
  var i:integer;
  begin
    accum^[0]:=values[0];
    for i:=1 to high(items) do accum^[i]:=accum^[i-1]+values[i];
  end;

  procedure setsaved;
  { initially, assume that no item is selected }
  var i:integer;
  begin for i:=0 to high(items) do saved^[i]:=0; end;

begin
  { if there is anything wrong with arguments, return 0 }
  knapsack:=0;
  if prerequisites then begin
    { provide a temporary place to store selections }
    getmem( saved, succ(high(items))*sizeof(items[0]));
    if assigned(saved) then begin
      { provide a temporary place to store accumulated value }
      setsaved; getmem( accum, succ(high(items))*sizeof(accum^[0]));
      if assigned(accum) then begin
        { start out assuming that nothing is selected and choose the }
        { last item                                                  }
        setaccum; value:=0; maxvalue:=0; choose(high(items));
        { when all permutations have been tried, return the maxvalue }
        knapsack:=maxvalue; restoreselection;
        freemem( accum, succ(high(items))*sizeof(accum^[0])); end;
      freemem( saved, succ(high(items))*sizeof(items[0])); end; end;
end;

function pack (
  const items:  array of word;
  var   bins:   array of word;
  const maxbin: word
  ): word;
{ Assign each size in the items array to a volume in the bins array  }
{ such that no more than maxbin size is accumulated into a bin.  As  }
{ many bins as necessary are used to "pack" all of the items into    }
{ bins and the function returns the total number of bins used.  The  }
{ assignment of items to bins is returned through the "bins" array.  }
{ where                                                              }
{   items: the "sizes" of each item                                  }
{   bins:  the returned bin assignment for each item                 }
{   maxbin: the maximum sum of sizes for all items assigned to a bin }
var
  excess, saved : ^largeray;
  lobin, okbin, curbin : integer;

  procedure locatebin(x:word);
  { locates a bin to which item "x" can be assigned.  Returns when }
  { all items of "x" and less can be assigned to "lobin" bins or   }
  { when all iterations have been tried without success.           }
  var i, first:integer;

    procedure setfirst;
    { if there are a number of items of the same size, considerable }
    { time can be saved by avoiding combinations that have already  }
    { been tested by assigning an items of the same size to a bin.  }
    { The procedure finds the last item of the same size as "x", if }
    { any, placed in a bin and only iterates from that bin.         }
    var j:integer;
    begin
      first:=0;
      for j:=x+1 to high(items) do if items[j]=items[x] then begin
        first:=bins[j]; exit end;
    end;

    procedure testlocate;
    { tests whether or not item "x" can be assigned to bin "i".       }
    { if so, tests the remaining items.  When all items are assigned, }
    { remembers the current assignment.                               }

      procedure savebins;
      { remembers the current assignment }
      var i:integer;
      begin for i:=0 to high(items) do saved^[i]:=bins[i]; end;
    var j:integer;
    begin {testlocate}
      if excess^[i]>=items[x] then begin { if bin "i" has room for item "x" }
        for j:=0 to i-1 do if excess^[j]=excess^[i] then exit;
        inc(total);
        write(x:5,i:5,total:10,^M);
        bins[x]:=i;                { try storing "x" in the bin              }
        if x<>0 then begin         { if there are items waiting to be stored }
          dec(excess^[i],items[x]);{ allocate space in bin "i" to item "x"   }
          locatebin(x-1);          { try to locate a bin for the next item   }
          { restore space to bin "i" for the next iteration }
          inc(excess^[i],items[x]); end
        else begin
          { when the last item is successfully stored, track the assignment }
          okbin:=curbin; savebins end; end;
    end; {testlocate}

  begin {locatebin}
    { avoid bins where something of equivalent size has already been tried }
    setfirst;
    { try to locate the item in the bins that already have something in them }
    for i:=first to curbin do begin
      testlocate;
      { if all items can be assigned to the current number of bins,      }
      { then we don't need to test other permutations for this number of }
      { bins                                                             }
      if (okbin=curbin) or (okbin=lobin) then exit; end;
    { if we can't get all the items into the current bins, try }
    { storing the item in a new bin.                           }
    if (lobin<okbin) and (succ(curbin)<okbin) then begin
      { unless we already know that fewer bins are required, locate }
      { the item to this bin                                        }
      inc(curbin); {open an empty bin}
      i:=curbin; testlocate; dec(curbin); {close the empty bin} end;
  end; {locatebin}

  procedure restorebins;
  var i:integer; begin for i:=0 to high(items) do bins[i]:=saved^[i]; end;

  procedure setexcess;
  var i:integer; begin for i:=0 to high(items) do excess^[i]:=maxbin; end;

  function setlobin:boolean;
  { determine the minimum number of bins required to store everything }
  { if the items are divided uniformly. When everything can be fit    }
  { into this number of bins, searching stops.                        }
  var i:integer; l:longint;
  begin
    setlobin:=false; l:=0;
    for i:=0 to high(items) do begin
      inc(l,items[i]);
      { if any one item is larger than a bin, return false }
      if items[i]>maxbin then exit; end;
    lobin:=l div maxbin; if (l mod maxbin)=0 then dec(lobin);
    setlobin:=true;
  end;

  procedure setsaved;
  { creates an initial assignment where every item is put into its }
  { own bin.                                                       }
  var i:integer; begin for i:=0 to high(items) do saved^[i]:=i; end;

begin {pack}
  pack:=0;
  if setlobin then begin
    getmem( excess, succ(high(items))*sizeof(items[0]));
    if excess<>NIL then begin
      getmem( saved, succ(high(items))*sizeof(items[0]));
      if saved<>NIL then begin
        setsaved; setexcess;
        { Always put the first item into a new bin.  Setting  }
        { "curbin:=-1" bypasses the loop to check if the item }
        { will fit in already open bins.                      }
        curbin:=-1;
        { We know that each item can be put into a bin by itself. }
        { This forms an upper bound to test against.              }
        okbin:=high(items); locatebin(high(items));
        restorebins; pack:=okbin+1;
        freemem( saved, succ(high(items))*sizeof(saved^[0])); end;
      freemem( excess, succ(high(items))*sizeof(excess^[0])); end; end;
end; {pack}

function subpack (
  const items:  array of word;
  var   bins:   array of word;
  const maxbin: word
  ): word;
{ Assign each size in the items array to a volume in the bins array  }
{ such that no more than maxbin size is accumulated into a bin.  As  }
{ many bins as necessary are used to "pack" all of the items into    }
{ bins and the function returns the total number of bins used.  The  }
{ assignment of items to bins is returned through the "bins" array.  }
{ where                                                              }
{   items: the "sizes" of each item                                  }
{   bins:  the returned bin assignment for each item                 }
{   maxbin: the maximum sum of sizes for all items assigned to a bin }
var
  excess, saved : ^largeray;
  lobin, okbin, curbin, maxtotal : integer;

  procedure locatebin(x:word);
  { locates a bin to which item "x" can be assigned.  Returns when }
  { all items of "x" and less can be assigned to "lobin" bins or   }
  { when all iterations have been tried without success.           }
  var i, first:integer;

    procedure setfirst;
    { if there are a number of items of the same size, considerable }
    { time can be saved by avoiding combinations that have already  }
    { been tested by assigning an items of the same size to a bin.  }
    { The procedure finds the last item of the same size as "x", if }
    { any, placed in a bin and only iterates from that bin.         }
    var j:integer;
    begin
      first:=0;
      for j:=x+1 to high(items) do if items[j]=items[x] then begin
        first:=bins[j]; exit end;
    end;

    procedure testlocate;
    { tests whether or not item "x" can be assigned to bin "i".       }
    { if so, tests the remaining items.  When all items are assigned, }
    { remembers the current assignment.                               }

      procedure savebins;
      { remembers the current assignment }
      var i:integer;
      begin for i:=0 to high(items) do saved^[i]:=bins[i]; end;
    var j:integer;
    begin {testlocate}
      if excess^[i]>=items[x] then begin { if bin "i" has room for item "x" }
        for j:=0 to i-1 do if excess^[j]=excess^[i] then exit;
        inc(total); write(x:5,i:5,total:10,^M);
        bins[x]:=i;                { try storing "x" in the bin              }
        if x<>0 then begin         { if there are items waiting to be stored }
          dec(excess^[i],items[x]);{ allocate space in bin "i" to item "x"   }
          locatebin(x-1);          { try to locate a bin for the next item   }
          { restore space to bin "i" for the next iteration }
          inc(excess^[i],items[x]); end
        else begin
          { when the last item is successfully stored, track the assignment }
          okbin:=curbin;
          if maxtotal<(3*total) then maxtotal:=3*total;
          savebins end; end;
    end; {testlocate}

  begin {locatebin}
    { avoid bins where something of equivalent size has already been tried }
    setfirst;
    { try to locate the item in the bins that already have something in them }
    for i:=first to curbin do begin
      testlocate;
      { if all items can be assigned to the current number of bins,      }
      { then we don't need to test other permutations for this number of }
      { bins                                                             }
      if (okbin=curbin) or (okbin=lobin)
        or (total>maxtotal) then exit; end;
    { if we can't get all the items into the current bins, try }
    { storing the item in a new bin.                           }
    if (lobin<okbin) and (succ(curbin)<okbin) then begin
      { unless we already know that fewer bins are required, locate }
      { the item to this bin                                        }
      inc(curbin); {open an empty bin}
      i:=curbin; testlocate; dec(curbin); {close the empty bin} end;
  end; {locatebin}

  procedure restorebins;
  var i:integer; begin for i:=0 to high(items) do bins[i]:=saved^[i]; end;

  procedure setexcess;
  var i:integer; begin for i:=0 to high(items) do excess^[i]:=maxbin; end;

  function setlobin:boolean;
  { determine the minimum number of bins required to store everything }
  { if the items are divided uniformly. When everything can be fit    }
  { into this number of bins, searching stops.                        }
  var i:integer; l:longint;
  begin
    setlobin:=false; l:=0;
    for i:=0 to high(items) do begin
      inc(l,items[i]);
      { if any one item is larger than a bin, return false }
      if items[i]>maxbin then exit; end;
    lobin:=l div maxbin; if (l mod maxbin)=0 then dec(lobin);
    setlobin:=true;
  end;

  procedure setsaved;
  { creates an initial assignment where every item is put into its }
  { own bin.                                                       }
  var i:integer; begin for i:=0 to high(items) do saved^[i]:=i; end;

begin {subpack}
  subpack:=0;  maxtotal:=2*high(items);
  if setlobin then begin
    getmem( excess, succ(high(items))*sizeof(items[0]));
    if excess<>NIL then begin
      getmem( saved, succ(high(items))*sizeof(items[0]));
      if saved<>NIL then begin
        setsaved; setexcess;
        { Always put the first item into a new bin.  Setting  }
        { "curbin:=-1" bypasses the loop to check if the item }
        { will fit in already open bins.                      }
        curbin:=-1;
        { We know that each item can be put into a bin by itself. }
        { This forms an upper bound to test against.              }
        okbin:=high(items); locatebin(high(items));
        restorebins; subpack:=okbin+1;
        freemem( saved, succ(high(items))*sizeof(saved^[0])); end;
      freemem( excess, succ(high(items))*sizeof(excess^[0])); end; end;
end; {pack}

var
  aitems : array [1..100] of word;
var
  abins: array [1..200] of word;
var
  aselection: array [1..200] of word;
var i,j,k:word;
begin
  assign(fo,''); rewrite(fo);
  for i:=1 to high(aitems) do aitems[i]:=(random(2*high(aitems))+1);
  {naivesort}
  {for i:=1 to high(aitems)-1 do for j:=i+1 to high(aitems) do
    if aitems[i]>aitems[j] then begin
      k:=aitems[i]; aitems[i]:=aitems[j]; aitems[j]:=k; end; }
{  for i:=high(aitems) to 2*high(aitems) do begin
    total:=0;
    writeln(fo, i:5,' ',pack( aitems, abins, i):5,total:10); end;}
{  for i:=high(aitems) to 2*high(aitems) do begin
    total:=0;
    writeln(fo, i:5,' ',subpack( aitems, abins, i):5,total:10); end;}
  for i:=1 to high(aitems) do abins[i]:=random(2*high(aitems))+1;
  {naivesort}
  for i:=1 to high(aitems)-1 do for j:=i+1 to high(aitems) do
    if abins[i]>abins[j] then begin
      k:=abins[i]; abins[i]:=abins[j]; abins[j]:=k; end;
  for i:=high(aitems) to 2*high(aitems) do
    writeln(fo, i:5,' ',knapsack(aitems, abins, aselection,i));
  close(fo);
end.