请教排列组合的算法

转别人的.需求如下：
   A：9位数
   B：由1-9这九个数组成，而且不允许重复，不允许有0
   C：生成到文本文件里
   其实也就是全排列问题，因为只是要结果，所以没考虑算法的优化，代码执行了5个多小时。权当抛砖引玉吧，代码如下，期待大家有好的算法^-^
{****************************************************}
procedure TForm1.Button1Click(Sender: TObject);
Var
    Ls, SameLs : TStringList;
    I : Int64;
    J : Integer;
    AStr : String;
begin
    Ls := TStringList.Create;
    SameLs := TStringList.Create;
    Try
        Try
            I := 123456788;
            While I < 987654320 do
            begin
                Application.ProcessMessages;
                AStr := IntToStr(I);
                SameLs.Clear;
                For J := 1 to 9 do
                begin
                    if AStr[J] = '0' then Break;
                    if SameLs.IndexOf(AStr[J]) <> -1 then Break;
                    SameLs.Add(AStr[J]);
                end;                if SameLs.Count = 9 then
                begin
                    Ls.Add(AStr);
                    Edit1.Text := AStr;
                end;
                Inc(I);
            end;
            Ls.SaveToFile('C:9.txt');
        Finally
            FreeAndNil(SameLs);
        end;
    Finally
        FreeAndNil(Ls);
    end;
end;
{****************************************************}结果那哥们说需求变了，需求如下：
  A：8位数          //修改的地方
  B：由1-9这九个数组成，而且不允许重复，不允许有0
   C：生成到文本文件里
那么代码对应修改如下，执行时间缩小到了20多分：
{****************************************************}
procedure TForm1.Button2Click(Sender: TObject);
Var
    Ls, SameLs : TStringList;
    I : Int64;
    J : Integer;
    AStr : String;
begin
    Ls := TStringList.Create;
    SameLs := TStringList.Create;
    Try
        Try
            I := 12345678;
            While I < 98765433 do
            begin
                Application.ProcessMessages;
                AStr := IntToStr(I);
                SameLs.Clear;
                For J := 1 to 8 do
                begin
                    if AStr[J] = '0' then Break;
                    if SameLs.IndexOf(AStr[J]) <> -1 then Break;
                    SameLs.Add(AStr[J]);
                end;                if SameLs.Count = 8 then
                begin
                    Ls.Add(AStr);
                    Edit1.Text := AStr;
                end;
                Inc(I);
            end;
            Ls.SaveToFile('C:8.txt');
        Finally
            FreeAndNil(SameLs);
        end;
    Finally
        FreeAndNil(Ls);
    end;
end;
{****************************************************}

呵呵，瞎写了个，玩玩
procedure TForm1.Button2Click(Sender: TObject);
var
        i: integer;
        ss: TStrings;
        mStr: string;
begin
        ss:= TStringList.Create;
        for i:=123 to 654 do
        begin
                mStr := IntToStr(i);
                if (Pos('7',mStr)>0) or (Pos('8',mStr)>0) or (Pos('9',mStr)>0) or (Pos('0',mStr)>0) then
                        Continue;
                ss.Add(mStr);
        end;
        ss.SaveToFile('d:\123.txt');
        ss.Destroy;
end;

//r-组合生成算法
//回溯法生成从n个元素中取出r个元素的所有组合情况#include<stdio.h>
#include<string.h>const int N = 10000;int n, r;
int res[N];
bool used[N];
int counter;void output()
{
        counter++;
        printf("Case %4d:", counter);
        for(int i = 1; i <= r; i++)
                printf(" %d", res[i]);
        putchar('\n');
}void c(int i)
{
        int j;
        for(j = res[i-1]+1; j <= n; j++)
        {
                if(!used[j])
                {
                        used[j] = true;
                        res[i] = j;
                        if(i == r)
                                output();
                        else
                                c(i+1);
                        used[j] = false;
                }
        }
}int main()
{
        res[0] = 0;
        memset(used, false, sizeof(used));
        while(scanf("%d%d", &n, &r)!=EOF)
        {
                counter = 0;
                c(1);
        }
        return 0;
}

123
124
125
126
134
135
136
145
146
156
234
235
236
245
246
256
345
346
356
456function Combination(mStrings: TStrings; mStr: string;
  mLen: Integer): Boolean; { 组合 }
  procedure fCombination(mLeft, mRight: string);
  var
    I: Integer;
  begin
    if Length(mLeft) >= mLen then
      mStrings.Add(mLeft)
    else for I := 1 to Length(mRight) do
      fCombination(mLeft + Copy(mRight, I, 1), Copy(mRight, I + 1, MaxInt));
  end;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    fCombination('', mStr);
  finally
    mStrings.EndUpdate;
  end;
  Result := True;
end; { Combination }procedure TForm1.Button1Click(Sender: TObject);
begin
  Combination(Memo1.Lines, '123456', 3);
end;

贴个收的组合算法  function mm(n: integer): integer;
  var
    i: integer;
  begin
    result := 1;
    for i := 1 to n do result := result * 2; // 求2^n的函数
  end;  procedure zh(n: integer);
  var
    i, j, n2, n1: integer;
    s: array of string;
  begin
    n1 := mm(n); //求2的n次方
    Self.Caption:=IntToStr(n1) ;
    SetLength(s, n1 + 1);
    mmo1.Lines.Clear;
    for i := 1 to n do
    begin
      n2 := mm(i - 1);
      for j := 1 to n1 do
      begin
        if ((j div n2) mod 2) = 1 then s[j] := s[j] + IntToStr(i);
      end;
    end;    for I := 1 to n1 do
      mmo1.Lines.Add(s[i]);
  end

调试易

请教排列组合的算法

解决方案 »