高分求一类似背包算法，等着急用阿，感激不尽！！！！！！！！

Question

通常打包要求有：1、码长限制；2、色光(A、B色)；3、装箱限量(就是限制这一箱装多少米)； 
其中码长通常为一范围, 色光为：A、B、C、D之类例：现假设有一批货，代号为：008
1、码长要求为 ≥30米；    
2、装箱限量≤200米
原始数据库中的数据(图1):                    
序号   数量(米)  色光  包号
1 60 A
2 70 B
3 80 A
4 20 A
5 40 B
6 50 C
7 70 A
8 30 A
9 50 B
10 18 B 开始计算结果如下(图2)序号 b 数量（米） 色光 包号
1 60 A 1
3 80 A 1
7 70 A 2
8 30 A 2
2 70 B 3
5 40 B 3
9 50 B 3
6 50 C 4
4 20 A 5
10 18 B 5注：1、在上例中，先剔除码长不符合要求的，然后再成件。
2、色光相同的要成在一个件中。
a.刚开始先把码长不符合要求的(码长要求为 ≥30米),如4号和10号放最下面
b。在色光A中按顺序数量相加，如60+80<200,若60+80+70=210>200,不符合要求，则包号为1。再次在色光为A中剩下的按顺序数量相加，如70+30=100<200
则包号为2
同理B,C
c．码长不符合要求的不管多少通统定为最后的数字
注:图2是按输入顺序得到的,那位会最优算法的更好

Answer 1

to 回复人： QuickKeyBoard
    my email:[email protected]
先谢过了

Answer 2

我已经给你把可执行文件发到邮箱里去了，请注意查收。这个问题我用了很长时间，最终的结果也不令我满意，原因在于它的最优化问题:楼主说这类似于背包问题，实际上不是，这是个np hard问题，可以简述为：有若干个物品要装走，每个的重量为w(i)，同样大小的箱子足够用，但每个只能装最多M的重量，问最少要用多少个箱子。
我同我的朋友侯启明同学（清华大学大三学生，noi国际金牌获得者）讨论了一下这个问题，结果是目前还找不到多项式级的有效算法可以解决这个问题。
所以，最终，我采用的是贪心法，可以得到一个“比较”不错的解。如果楼下有朋友可以想到多项式级的有效算法，请一定贴个答案上来，不胜感激。
下面，我将我的代码写出来，世外的高人给看看有什么错误没有。由于我事先不知道问题的最大规模，所以，没有使用穷举的办法解决。
windowsxp sp2 delphi7 下通过，纯api win32程序：program Bag;{$R 'XP.res' 'XP.rc'}
{$R 'RES.res' 'RES.RC'}uses
  Windows, Messages, CommDlg;{$include res.inc}const
  MINLEN = 30;
  MAXSUM = 200;type
  TNode = record
    ID, Len, Bag: Integer;
    Col: Char;
  end;
  TNodeArray = array of TNode;var
  Good: array ['A'..'Z'] of TNodeArray;
  Bad: TNodeArray;
  BagID: Integer;procedure ReadData(fn: PChar);
var
  temp: TNode;
  f: TextFile;
  c: Char;
begin
  { Init. }
  FillChar(Good, 26 * SizeOf(TNodeArray), 0);
  Bad := nil;  { Read data. }
  AssignFile(f, fn);
  Reset(f);
  while not Eof(f) do
  begin
    Read(f, temp.ID, temp.Len, temp.Col);
    while (temp.Col < 'A') or (temp.Col >'Z') do
      Read(f, temp.Col);    if temp.Len >= MINLEN then
    begin
      SetLength(Good[temp.Col], High(Good[temp.Col]) + 2);
      Good[temp.Col, High(Good[temp.Col])] := temp;
    end
    else
    begin
      SetLength(Bad, High(Bad) + 2);
      Bad[High(Bad)] := temp;
    end;
  end;
  CloseFile(f);
end;procedure SplitBag(var bs: Integer; var d: TNodeArray);
var
  remain: array of integer;
  n, i, j, m, p: Integer;
  test: Boolean;
  temp: TNode;
begin
  n := 1;
  test := true;
  while test do
  begin
    SetLength(remain, n);
    for j := 0 to n - 1 do
      remain[j] := MAXSUM;    for i := 0 to High(d) do
    begin
      m := 0;
      for j := 0 to n - 1 do
        if remain[j] > m then
        begin
          m := remain[j];
          p := j;
        end;      if m >= d[i].Len then
      begin
        d[i].Bag := p + bs;
        Dec(remain[p], d[i].Len);
      end
      else
        break;
    end;    if i > High(d) then
      test := False;    Inc(n);
  end;  Inc(bs, n - 1);  for i := 0 to High(d) - 1 do
    for j := i + 1 to High(d) do
      if d[i].Bag > d[j].Bag then
      begin
        temp := d[i];
        d[i] := d[j];
        d[j] := temp;
      end;
end;procedure WriteOut(fn: pChar);
var
  c: Char;
  i, j: integer;
  f: TextFile;
begin
  { Calculate and save result. }
  AssignFile(f, fn);
  ReWrite(f);
  Writeln(f, '序号':5,  '数量':5, '色光':5, '包号':5);
  j := 1;
  for c := 'A' to 'Z' do
    if Good[c] <> nil then
    begin
      SplitBag(j, Good[c]);
      for i := 0 to High(Good[c]) do
        Writeln(f, Good[c, i].ID:5, Good[c, i].Len:5, Good[c, i].Col:5, Good[c, i].Bag:5);
      Writeln(f);
    end;
  Writeln(f);
  SplitBag(j, Bad);
  for i := 0 to High(Bad) do
    Writeln(f, Bad[i].ID:5, Bad[i].Len:5, Bad[i].Col:5, Bad[i].Bag:5);
  CloseFile(f);  // Free Memory
  for c := 'A' to 'Z' do
    Good[c] := nil;
  Bad := nil;
end;function DlgProc(hWnd: HWND; Msg: WORD; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  ofn: OPENFILENAME;
  fn: PChar;
begin
  GetMem(fn, 300 * SizeOf(Char));
  FillChar(ofn, SizeOf(OPENFILENAME), 0);
  ofn.lStructSize := SizeOf(OPENFILENAME);
  ofn.hWndOwner := hWnd;
  ofn.hInstance := hInstance;
  ofn.lpstrFilter := '文本文件(*.TXT)'#0'*.TXT'#0#0;
  ofn.lpstrFile := fn;
  ofn.nMaxFile := 300;
  ofn.lpstrDefExt := 'TXT';
  ofn.Flags := OFN_OVERWRITEPROMPT;  case Msg of  WM_INITDIALOG:
    Result := 1;  WM_CLOSE:
    EndDialog(hWnd, 0);  WM_COMMAND:
    case LOWORD(wParam) of    IDC_READ:
      if GetOpenFileName(ofn) = True then
      begin
        ReadData(fn);
        EnableWindow(GetDlgItem(hWnd, IDC_WRITE), True);
      end;    IDC_WRITE:
      if GetSaveFileName(ofn) = True then
      begin
        WriteOut(fn);
        EnableWindow(GetDlgItem(hWnd, IDC_WRITE), False);
      end;    end;// case LOWORD(wParam) of  end;// case Msg of  Result := 0;  FreeMem(fn);
end;// functionbegin
  DialogBox(hInstance, MAKEINTRESOURCE(MAINWINDOW), 0, @DlgProc);
end.