你买本基于delphi的算法的书吧(书店有)
看高中课本

解决方案 »

  1.   

    我新写的几个函数,很初步,并且效率不高,但是可以简单的实现等概率、排除选定组合、包含选定组合的取值,希望能够交流一下。使用函数前不要忘了Randomize呀,要不然呵呵。  //----------------------------------------------------------------------------
      //函数:function CharFrequency(const subString,s:string):integer;
      //作用:取得指定子句subString在字符串s中出现的频率
      //参数:subString:子句;s查询字符串。
      //----------------------------------------------------------------------------
      function CharFrequency(const subString,s:string):integer;
      var
        internalString:string;
        i,j,k:integer;
      begin
        internalString:=s;
        k:=0;
        j:=Length(subString);
        i:=Pos(substring,internalString);
        while i>0 do
        begin
          k:=k+1;
          Delete(internalString,i,j);
          i:=Pos(substring,internalString);
        end;
        result:=k;
      end;
      //----------------------------------------------------------------------------
      //函数:function GetLottery(SumSeeds,LotSeeds:integer):string;
      //作用:等概率取得在选定范围内[1..SumSeeds]中LotSeeds数量的一个随机数序列
      //参数:SumSeeds:取数范围,从1开始;LotSeeds:随机数序列的长度。
      //----------------------------------------------------------------------------
      function GetLottery(SumSeeds,LotSeeds:integer):string;
      var
        FromBalls,ToBalls:array of integer;
        i,j,k,l,m:integer;
        s:string;
      begin
        SetLength(ToBalls,LotSeeds);
        SetLength(FromBalls,SumSeeds);
        k:=SumSeeds;
        for i:=1 to LotSeeds do
        begin
          j:=1+random(k);
          for l:=1 to SumSeeds do
          begin
            if l>j then
            begin
              ToBalls[i-1]:=j;
              FromBalls[j-1]:=i;
              Break;
            end
            else
            begin
              if FromBalls[l-1]<>0 then
                Inc(j)
              else
              begin
                if l=j then
                begin
                  ToBalls[i-1]:=j;
                  FromBalls[j-1]:=i;
                  Break;
                end;
              end;
            end;
          end;
          Dec(k);
          s:=s+Format('%2.2d',[Toballs[i-1]])+',';
        end;
        result:=s;
      end;  //----------------------------------------------------------------------------
      //函数:function ExceptLot(SumSeeds,LotSeeds:integer;ExceptStr:array of integer):string;
      //作用:排除制定的整数序列ExceptStr,
      //      取得在选定范围内[1..SumSeeds]中LotSeeds数量的一个随机数序列
      //参数:SumSeeds:取数范围,从1开始;LotSeeds:随机数序列的长度;ExceptStr:被排除的证书序列,
      //      使用方式如[1,2,3,4]。
      //----------------------------------------------------------------------------
      function ExceptLot(SumSeeds,LotSeeds:integer;ExceptStr:array of integer):string;
      var
        FromBalls,ToBalls:array of integer;
        i,j,k,l,m:integer;
        s:string;
      begin
        if Length(ExceptStr)>=(SumSeeds-LotSeeds) then
        begin
          ShowMessage('排除范围过大');
          Result:='';
          Exit;
        end;    LotSeeds:=LotSeeds+Length(ExceptStr);//注意和包含取法的不同
        SetLength(ToBalls,LotSeeds);
        SetLength(FromBalls,SumSeeds);
        for i:=0 to Length(ExceptStr)-1 do
        begin
          ToBalls[i]:=ExceptStr[i];
          FromBalls[ToBalls[i]-1]:=i+1;
        end;    k:=SumSeeds-Length(ExceptStr);
        for i:=1+Length(ExceptStr) to LotSeeds do
        begin
          j:=1+random(k);
          for l:=1 to SumSeeds do
          begin
            if l>j then
            begin
              ToBalls[i-1]:=j;
              FromBalls[j-1]:=i;
              Break;
            end
            else
            begin
              if FromBalls[l-1]<>0 then
                Inc(j)
              else
              begin
                if l=j then
                begin
                  ToBalls[i-1]:=j;
                  FromBalls[j-1]:=i;
                  Break;
                end;
              end;
            end;
          end;
          Dec(k);
          s:=s+Format('%2.2d',[Toballs[i-1]])+',';
        end;
        result:=s;
      end;  //----------------------------------------------------------------------------
      //函数:function IncludeLot(SumSeeds,LotSeeds:integer;ExceptStr:array of integer):string;
      //作用:始终选定指定的整数序列ExceptStr,
      //      取得在选定范围内[1..SumSeeds]中LotSeeds(包含Exceptstr)数量的一个随机数序列
      //参数:SumSeeds:取数范围,从1开始;LotSeeds:随机数序列的长度;ExceptStr:始终包含的整数序列,
      //      使用方式如[1,2,3,4]。
      //----------------------------------------------------------------------------
      function IncludeLot(SumSeeds,LotSeeds:integer;ExceptStr:array of integer):string;
      var
        FromBalls,ToBalls:array of integer;
        i,j,k,l,m:integer;
        s:string;
      begin
        if Length(ExceptStr)>=LotSeeds then
        begin
          ShowMessage('包含范围过大');
          Result:='';
          Exit;
        end;    SetLength(ToBalls,LotSeeds);
        SetLength(FromBalls,SumSeeds);
        
        for i:=0 to Length(ExceptStr)-1 do
        begin
          ToBalls[i]:=ExceptStr[i];
          FromBalls[ToBalls[i]-1]:=i+1;
          s:=s+Format('%2.2d',[Toballs[i]])+',';//包含时的做法
        end;    k:=SumSeeds-Length(ExceptStr);
        for i:=1+Length(ExceptStr) to LotSeeds do
        begin
          j:=1+random(k);
          for l:=1 to SumSeeds do
          begin
            if l>j then
            begin
              ToBalls[i-1]:=j;
              FromBalls[j-1]:=i;
              Break;
            end
            else
            begin
              if FromBalls[l-1]<>0 then
                Inc(j)
              else
              begin
                if l=j then
                begin
                  ToBalls[i-1]:=j;
                  FromBalls[j-1]:=i;
                  Break;
                end;
              end;
            end;
          end;
          Dec(k);
          s:=s+Format('%2.2d',[Toballs[i-1]])+',';
        end;
        result:=s;
      end;  //----------------------------------------------------------------------------
      //函数:function CallGetInclude(SumSeeds,LotSeeds:integer;ExceptStr:string):string;
      //作用:将符合要求格式的ExceptStr:string转化为array of integer,并调用函数IncludeLot;
      //参数:解释略
      //----------------------------------------------------------------------------
      function CallGetInclude(SumSeeds,LotSeeds:integer;ExceptStr:string):string;
      var
        i,j,iRound,iLength:integer;
        iParam:array of integer;
        sParam,s:string;
      begin
        sParam:=ExceptStr;
        iRound:=CharFrequency(',',sParam);
        iLength:=Length(sParam);
        if Copy(sParam,iLength,1)<>',' then
        begin
          iRound:=iRound+1;
          iLength:=iLength+1;
          sParam:=sParam+',';
        end;
        SetLength(iParam,iRound);
        s:='';
        j:=0;
        for i:=1 to iLength do
        begin
          if sParam[i]=',' then
          begin
            iParam[j]:=StrToIntDef(s,0);
            s:='';
            inc(j);
          end
          else
          begin
            s:=s+sParam[i];
          end;
        end;
        result:=IncludeLot(SumSeeds,LotSeeds,iParam);
      end;  //----------------------------------------------------------------------------
      //函数:function CallGetExcept(SumSeeds,LotSeeds:integer;ExceptStr:string):string;
      //作用:将符合要求格式的ExceptStr:string转化为array of integer,并调用函数ExceptLot;
      //参数:解释略
      //----------------------------------------------------------------------------
      function CallGetExcept(SumSeeds,LotSeeds:integer;ExceptStr:string):string;
      var
        i,j,iRound,iLength:integer;
        iParam:array of integer;
        sParam,s:string;
      begin
        sParam:=ExceptStr;
        iRound:=CharFrequency(',',sParam);
        iLength:=Length(sParam);
        if Copy(sParam,iLength,1)<>',' then
        begin
          iRound:=iRound+1;
          iLength:=iLength+1;
          sParam:=sParam+',';
        end;
        SetLength(iParam,iRound);
        s:='';
        j:=0;
        for i:=1 to iLength do
        begin
          if sParam[i]=',' then
          begin
            iParam[j]:=StrToIntDef(s,0);
            s:='';
            inc(j);
          end
          else
          begin
            s:=s+sParam[i];
          end;
        end;
        result:=ExceptLot(SumSeeds,LotSeeds,iParam);
      end;
      
      

  2.   

    //快速全排列procedure TForm1.Button1Click(Sender: TObject);
    var
      {A1, A2, A3, A4,} A5, A6, A7, A8, A9, A10: Integer;
      {S1, S2, S3, S4, S5,} S6, S7, S8, S9, S10: string;
      S11: string;
      vStringList: TStringList;
    begin
      vStringList := TStringList.Create;
      try
        S11 := '0123456789';
        for A10 := 1 to 10 do begin
          S10 := S11;
          Delete(S10, A10, 1);
          for A9 := 1 to 9 do begin
            S9 := S10;
            Delete(S9, A9, 1);
            for A8 := 1 to 8 do begin
              S8 := S9;
              Delete(S8, A8, 1);
              for A7 := 1 to 7 do begin
                S7 := S8;
                Delete(S7, A7, 1);
                for A6 := 1 to 6 do begin
                  S6 := S7;
                  Delete(S6, A6, 1);
                  for A5 := 1 to 5 do
                    vStringList.Add(S11[A10] + S10[A9] + S9[A8] + S8[A7] + S7[A6] + S6[A5]);
                end;
              end;
            end;
          end;
        end;
        vStringList.SaveToFile('C:\Temp.txt'); //文件很大,可以用Delphi打开看看
      finally
        vStringList.Free;
      end;
    end;