1-30个数中随意取13个号码，按7个一组进行组合的算法

Question

指定13个1-30之间的数字，按7个号码一组进行组合（不考虑顺序），并将7个一组的组合依次装入stringGrid中，（如号码为2、4、6、7、10、11、13、15、14、21、24、26、30共13个号码，按照7个一组进行组合），如何实现？
2、从生成的每组7个组合中，再将7个数字相加之和小于60的组合筛选出来，如何实现？
盼望高手回答，高分相送

Answer 1

补充，筛选后的组合再装入另一个stringGrid中，一定要有代码

Answer 2

数量是对的，每行对不对LZ验证吧，呵呵。导到stringGrid，你懂的。procedure TForm1.Button3Click(Sender: TObject);
var
        s1,s2:TStringList;
        i,j,k: integer;
        mstr,ss: string;
begin
        s1 := TStringList.Create;
        s1.Delimiter := ',';
        s1.DelimitedText := '2,4,6,7,10,11,13,15,14,21,24,26,30';        s2 := TStringList.Create;
        s2.Duplicates := dupIgnore;
        s2.Sorted := True;
        mstr := '';
        for i:=0 to s1.Count-1 do
                mstr := mstr + chr(ord('A')+StrToInt(s1.Strings[i]));
        s2.Add(mstr);
        i:=0;
        while i<s2.Count do
        begin
                mstr := s2.Strings[i];
                if Length(mstr)=7 then
                begin
                        Inc(i);
                        continue;
                end;                s2.Delete(i);
                for j:=1 to Length(mstr) do
                begin
                        ss := mstr;
                        Delete(ss,j,1);
                        s2.Add(ss);
                end;
                i:=0;
        end;        s1.Assign(s2);
        for i:=0 to s1.Count-1 do
        begin
                mstr := s1.Strings[i];
                ss := '';
                for j:=1 to Length(mstr) do
                        ss := ss + IntToStr(ord(mstr[j])-ord('A')) + ',';
                Delete(ss,Length(ss),1);
                s1.Strings[i] := ss;
        end;
        //全部组合
        memo1.Lines.Clear;
        memo1.Lines.Add('all(' + IntToStr(s1.Count) + ')');
        memo1.Lines.Add('----------------');
        memo1.Lines.AddStrings(s1);        //合数小于60
        s1.Assign(s2);
        i := 0;
        while i< s1.Count do
        begin
                mstr := s1.Strings[i];
                k := 0;
                for j:=1 to Length(mstr) do
                        k := k + ord(mstr[j]) - ord('A');
                if k>=60 then
                begin
                        s1.Delete(i);
                        continue;
                end;                ss := '';
                for j:=1 to Length(mstr) do
                        ss := ss + IntToStr(ord(mstr[j])-ord('A')) + ',';
                Delete(ss,Length(ss),1);
                s1.Strings[i] := ss;
                Inc(i);
        end;        Memo1.Lines.Add('sum<60(' + IntToStr(s1.Count) + ')');
        memo1.Lines.Add('----------------');
        memo1.Lines.AddStrings(s1);
end;

Answer 3

2楼的kaikai兄弟，上次连号的代码还有判断不连号就等于0，这个问题还没解决，请您帮忙啊
http://topic.csdn.net/u/20111215/00/3e50403a-0295-4294-85e9-6b1d38a87af8.html
这个链接14楼的问题没解决，请kaikai兄弟继续帮我

Answer 4

無連號:delete(s,length(s),1);
if s=''　then
   s='0';
edit1.text:=s;

Answer 5

十分谢谢kaikai兄弟，另外kaikai兄弟对本帖算法有何高招吗？

Answer 6

你的机器是586吧，我这个老爷本，ibm r50e（2005年初买），运行上面14选7也就10秒开始时间13:33:52
all(3432)
----------------
2,4,6,7,26,30,31
2,4,6,7,10,26,30
2,4,6,7,10,26,31
.....
sum<60(9)
----------------
2,4,6,7,10,11,13
2,4,6,7,10,11,14
2,4,6,7,10,11,15
2,4,6,7,10,13,14
2,4,6,7,10,13,15
2,4,6,7,10,15,14
2,4,6,7,11,13,14
2,4,6,7,11,13,15
2,4,6,7,11,15,14
结束时间13:34:01再说了，就那点代码，自己优化下啊，看不懂吗？子曰：不愤不启，不排不发。举一隅不以三隅反，则不复也。其实，是可以优化的，你看看原代码哪里是瓶颈？
我优化后14选7，老爷本上1秒。

Answer 7

我是新手，真的找不出瓶颈，真心向您请教了，请给我注释一下，我好好学习一下，拜托了，真心想拜您为师，我知道您的QQ不便公布，我的QQ是570633255，请加我，跪谢

Answer 8

erhan兄弟，真的生气了吗,真的不给我一个学习的机会吗？跪求您的优化后、加注释的代码。万分感激您，真的

Answer 9

erhan兄弟，真的不接受我的道歉吗？真不愿意帮我吗？求您了，把优化代码给我吧，也让我这个新手多学习一下吧

Answer 10

求您了，erhan兄弟，还在在线等您的代码。这么诚心难道不能感动您吗，都快哭了。

Answer 11

没生气，有啥可生气的啊，就算是故意写的3分钟，也只是夸张一下，我早说了代码效率不高可以优化的。别傻等了，代码看不懂，delphi里F1看帮助。程序不知道怎么转的，把13选7改成9选7，单步调试跟着走一圈，也可以加些代码，把中间结果输出出来看看，程序是怎么一步步把结果导出来的。学习的诚意就是完成我的第一个要求：说出原代码的瓶颈在哪；我不听口号的。

Answer 12

单步调试了一下，while i<s2.Count do
        begin
                mstr := s2.Strings[i];
                if Length(mstr)=7 then
                begin
                        Inc(i);
                        continue;
                end;                s2.Delete(i);
                for j:=1 to Length(mstr) do
                begin
                        ss := mstr;
                        Delete(ss,j,1);
                        s2.Add(ss);
                end;
这段循环

Answer 13

谁能帮我优化一下3楼的代码以提高运算效率啊，拜托大家了，我是新手，确实不会，拜托大家帮忙了，erhan兄弟，我是真的不会，你就不能好事做到底吗？我不是不学，是现在的水平有限，要学也得慢慢来啊。

Answer 14

4楼原程序
4743712 Loop @1592ms改进1
10181 Loop @905ms
  timestart := GetTickcount;
  count := 0;
  while s2.Count > 0 do
  begin
    inc(count);
    mstr := s2.Strings[i];
    //    if Length(mstr) = 7 then
    //    begin
    //      Inc(i);
    //      continue;
    //    end;
    flen := Length(mstr);
    s2.Delete(i);
    if flen > 8 then
      for j := 1 to flen do
      begin
        ss := mstr;
        Delete(ss, j, 1);
        s2.Add(ss);
      end
    else
      for j := 1 to flen do
      begin
        ss := mstr;
        Delete(ss, j, 1);
        s3.Add(ss);
      end;    i := 0;
  end;  timestart := GetTickcount - timestart;最傻的写法，效率
@0ms  s2 := TStringList.Create;
  //        s2.Duplicates := dupIgnore;
  //        s2.Sorted := True;
  mstr := '';
  for i := 0 to s1.Count - 1 do
    mstr := mstr + chr(ord('A') + StrToInt(s1.Strings[i]));
  //        s2.Add(mstr);
  //        i:=0;
  timestart := GetTickcount;
  flen := length(mstr);
  for L1 := 1 to flen - 6 do
    for L2 := L1 + 1 to flen - 5 do
      for L3 := L2 + 1 to flen - 4 do
        for L4 := L3 + 1 to flen - 3 do
          for L5 := L4 + 1 to flen - 2 do
            for L6 := L5 + 1 to flen - 1 do
              for L7 := L6 + 1 to flen do
                s2.Add(mstr[L1] + mstr[L2] + mstr[L3] + mstr[L4] + mstr[L5] +
                  mstr[L6] + mstr[L7]);
  timestart := GetTickcount - timestart;

Answer 15

最慢的递归
@8003ms  procedure fun(Asrc: string);
  var
    ftmp: string;
    flen: Cardinal;
    k: integer;
  begin
    flen := length(Asrc);
    if flen > 7 then
      for k := 1 to  flen do
      begin
        ftmp := Asrc;
        delete(ftmp, k, 1);
        fun(ftmp);
      end
    else
    begin
      s2.Add(Asrc);
    end;
  end;

Answer 16

你好，承蒙您指教。
s2 := TStringList.Create;
  //        s2.Duplicates := dupIgnore;
  //        s2.Sorted := True;
  mstr := '';
  for i := 0 to s1.Count - 1 do
    mstr := mstr + chr(ord('A') + StrToInt(s1.Strings[i]));
  //        s2.Add(mstr);
  //        i:=0;
  timestart := GetTickcount;
  flen := length(mstr);
  for L1 := 1 to flen - 6 do
    for L2 := L1 + 1 to flen - 5 do
      for L3 := L2 + 1 to flen - 4 do
        for L4 := L3 + 1 to flen - 3 do
          for L5 := L4 + 1 to flen - 2 do
            for L6 := L5 + 1 to flen - 1 do
              for L7 := L6 + 1 to flen do
                s2.Add(mstr[L1] + mstr[L2] + mstr[L3] + mstr[L4] + mstr[L5] +
                  mstr[L6] + mstr[L7]);
  timestart := GetTickcount - timestart;
我是个新手，现在，我要实现两组号码合成7个一组的号码组合，例如，第一组号码可能是1个、2个、3个、4个、5个、6个，就是6个以内不固定的个数的号码，第二组号码是30个以内不固定个数的号码，我要实现以下功能：当第一组号码是1个时，7个一组号码中剩下的6个号码从第二组中选取，并保证使第一组的号码一定出现在7个一组的组合中，举例说明：第一组号码为1、2，第二组号码为3、4、5、6、7、8、9、10，用着两组号码生成7个一组的全部组合，7个号码中，除去第一组2个号码，剩余5个号码在第二组8个号码中选取，即8选5，合成组合，并保证第一组号码1、2必定出现在7个一组的蛤蟆组合中，如何实现？请指教。如何在以上代码基础上更改实现这个功能。