function 返回组合数(m, n: integer): integer; var id: integer; begin id := 1; for var i := m downto (m - n + 1) do id := id * i;
for var i := n downto 1 do id := round(id / i); result := id; end; function 组合(var s: array of string; const n: integer): tarray<tarray<string>>; var l: array of integer; id, ie, i, j, lh: integer; max: array of Integer; xs: tarray<TArray<string>>; begin id := 返回组合数(length(s), n); lh := n - 1;
SetLength(xs, id, n);
setlength(l, n); id := 0; SetLength(max, n); id := 0; for i := (high(s) - n + 1) to high(s) do begin max[id] := i; inc(id); end;
id := 0; for i := 0 to n - 1 do l[i] := i; while true do begin
for i := 0 to (n - 1) do begin xs[id][i] := s[l[i]]; end;
Inc(id); if l[0] = max[0] then break;
for i := lh downto 0 do begin if l[i] <> max[i] then begin inc(l[i]); if i < lh then begin ie := l[i]; for j := i + 1 to lh do begin inc(ie); l[j] := ie; end; end; break; end; end; end; result := xs; xs := nil; l := nil; end;
procedure TForm1.Button1Click(Sender: TObject); var 红球基本号码: array[0..32] of string; 红球全集: tarray<tarray<string>>; st: tstopwatch; begin st := tstopwatch.create; st.Reset; st.Start; for var i := 0 to High(红球基本号码) do 红球基本号码[i] := Format('%.2d', [i + 1]); 红球全集 := 组合(红球基本号码, 6); st.stop; showmessage('耗时' + st.ElapsedMilliseconds.tostring + '共' + length(红球全集).tostring); end;
大致的算法如下, 电脑没装delphi, 记事本写的,不一定对,你自己调试一下 //定义一个全局变量查表用 var tabledata : array[0..28,1..6] of integer;
//初始化这个查询表 procedure inittable; var i,j:integer; begin for i := 1 to 28 do tabledata[i,6] := i; for i := 5 downto 1 do for j := 1 to 28 do tabledata[j,i]:=tabledata[j-1,i]+tabledata[j,i+1]; end;
type TData = array[1..6] of integer; //输入一个序号,返回TDATA表示的6个数值 function GetData(n:integer):TData; var i,j : integer; begin for i := 1 to 6 do begin j := 1; while n> tabledata[j,i] do begin dec(n,tabledata[j,i]) inc(j); end; Result[i] := 28+i-j; end; end;
----------------------------------------------
-
type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.fmx}
function 返回组合数(m, n: integer): integer; var id: integer; begin id := 1; for var i := m downto (m - n + 1) do id := id * i;
for var i := n downto 1 do id := Round(id / i);
Result := id; end;
function 组合(var s: array of string; const n: integer): TArray<TArray<string>>; var l: array of integer; id, i, j: integer; xs: TArray<TArray<string>>; maxMask, mask, bit: integer; begin id := 返回组合数(length(s), n);
SetLength(xs, id, n);
SetLength(l, n);
maxMask := (1 shl Length(s)) - 1; id := 0; mask := 0; while mask <= maxMask do begin j := 0; bit := 1; for i := 0 to Length(s) - 1 do begin if (mask and bit) <> 0 then begin xs[id][j] := s[i]; Inc(j); end; bit := bit shl 1; end; Inc(id); mask := mask + 1; while (mask and (1 shl n)) <> 0 do begin mask := mask + 1; end; end;
Result := xs; xs := nil; l := nil; end;
procedure TForm1.Button1Click(Sender: TObject); var 红球基本号码: array[0..32] of string; 红球全集: TArray<TArray<string>>; st: TStopwatch; begin st := TStopwatch.Create; st.Reset; st.Start; for var i := 0 to High(红球基本号码) do 红球基本号码[i] := Format('%.2d', [i + 1]); 红球全集 := 组合(红球基本号码, 6); st.Stop; ShowMessage('耗时 ' + st.ElapsedMilliseconds.ToString + ' 毫秒,共 ' + Length(红球全集).ToString + ' 个组合。'); end;
添加了多线程,未调试 function 组合(var s: array of string; const n: integer): TArray<TArray<string>>; var l: array of integer; id, i, j: integer; xs: TArray<TArray<string>>; maxMask, mask, bit: integer; begin id := 返回组合数(length(s), n);
SetLength(xs, id, n);
SetLength(l, n);
maxMask := (1 shl Length(s)) - 1; id := 0; mask := 0; TParallel.For(0, id, procedure(i: integer) var j, bit, k: integer; tempMask: integer; temp: TArray<string>; begin tempMask := i; j := 0; bit := 1; SetLength(temp, n); for k := 0 to Length(s) - 1 do begin if (tempMask and bit) <> 0 then begin temp[j] := s[k]; Inc(j); end; bit := bit shl 1; end; xs[i] := temp; end);
function 组合(var s: array of string; const n: integer): TArray<TArray<string>>; var sCopy: TArray<string>; // 复制一份 s l: array of integer; id, i, j: integer; xs: TArray<TArray<string>>; maxMask, mask, bit: integer; begin // 复制 s SetLength(sCopy, Length(s)); TArray.Copy<string>(s, sCopy, Length(s));
id := 返回组合数(length(s), n);
SetLength(xs, id, n);
SetLength(l, n);
maxMask := (1 shl Length(s)) - 1; id := 0; mask := 0; TParallel.For(0, id, procedure(i: integer) var j, bit, k: integer; tempMask: integer; temp: TArray<string>; begin tempMask := i; j := 0; bit := 1; SetLength(temp, n); for k := 0 to Length(sCopy) - 1 do begin if (tempMask and bit) <> 0 then begin temp[j] := sCopy[k]; Inc(j); end; bit := bit shl 1; end; xs[i] := temp; end);
//调用 procedure calc; var data: Tdata; d1: TStopwatch; i, k: Integer; begin d1 := TStopwatch.StartNew; Randomize; for k := 1 to 10000 * 10 do begin selectit(data);
for I := iMaxCol - iMaxSel + 1 to iMaxCol do begin //随机数存在data[28..33] end; end; d1.Stop; end;
----------------------------------------------
-
procedure EnumValue(Base: UInt64; BaseIndex: Integer; var DataList: TDataList; var Count: Integer); inline; var j, k, L, M, N: Integer; begin for j := 4 to BaseIndex - 1 do begin Base := Base + MoveMask[j]; DataList[Count] := Base; Inc(Count); for k := 3 to j - 1 do begin Base := Base + MoveMask[k]; DataList[Count] := Base; Inc(Count); for L := 2 to k - 1 do begin Base := Base + MoveMask[L]; DataList[Count] := Base; Inc(Count); for M := 1 to L - 1 do begin Base := Base + MoveMask[M]; DataList[Count] := Base; Inc(Count); for N := 0 to M - 1 do begin Base := Base + MoveMask[N]; DataList[Count] := Base; Inc(Count); end; end; end; end; end; end;
procedure TForm1.EnumAllValues(var DA: TDataList); var i, Count: Integer; Base: UInt64; N: array [5 .. BallCount - 2] of Integer; Tasks: array [5 .. BallCount - 2] of ITask; T: ITask; begin // 数据准备 Base := $3F; // 6位1 DA[0] := Base; Count := 1;
for i := 5 to BallCount - 2 do begin Base := Base + MoveMask[i]; N[i] := 0; DA[Count] := Base; Inc(Count); EnumValue(Base, i, DA, Count); end; end;
procedure TForm1.Button1Click(Sender: TObject); var i: Integer; st: TStopWatch; begin
st := TStopWatch.Create; st.Reset; st.Start; for i:=0 to 999 do EnumAllValues(DA); st.Stop; ShowMessage(Format('Average Time:%f ms', [st.ElapsedMilliseconds/1000.0])); end;
function Calc33: Integer; type OneItem = array[1..6] of Byte; var i1, i2, i3, i4, i5, i6: Byte; ic: Integer; i: Byte; iCol: OneItem; Item: OneItem; begin
for I := 1 to 6 do begin iCol[i] := 27 + i; end;
ic := 0;
for I1 := 1 to iCol[1] do for I2 := i1 + 1 to iCol[2] do for I3 := i2 + 1 to iCol[3] do for I4 := i3 + 1 to iCol[4] do for I5 := i4 + 1 to iCol[5] do for I6 := i5 + 1 to iCol[6] do begin Item[1] := i1; Item[2] := i2; Item[3] := i3; Item[4] := i4; Item[5] := i5; Item[6] := i6; inc(ic); end;
Result := ic; end;
----------------------------------------------
-
function Calc33a: Integer; type OneItem = array[1..6] of Byte; var i1, i2, i3, i4, i5, i6: Byte; ic: Integer; i: Byte; iCol: OneItem; ArItem: array of OneItem; pItem: ^OneItem; begin SetLength(ArItem, 1107568);
for I := 1 to 6 do begin iCol[i] := 27 + i; end;
ic := 0;
for I1 := 1 to iCol[1] do for I2 := i1 + 1 to iCol[2] do for I3 := i2 + 1 to iCol[3] do for I4 := i3 + 1 to iCol[4] do for I5 := i4 + 1 to iCol[5] do for I6 := i5 + 1 to iCol[6] do begin pItem := @ArItem[ic];
function Calc33a: Integer; type OneItem = array[1..6] of Byte; var i1, i2, i3, i4, i5, i6: Byte; ic: Integer; i: Byte; iCol: OneItem; ArItem: array of OneItem; pItem: ^OneItem; begin SetLength(ArItem, (33 * 32 * 31 * 30 * 29 * 28) div 720);
for I := 1 to 6 do begin iCol[i] := 27 + i; end;
ic := 0;
for I1 := 1 to iCol[1] do for I2 := i1 + 1 to iCol[2] do for I3 := i2 + 1 to iCol[3] do for I4 := i3 + 1 to iCol[4] do for I5 := i4 + 1 to iCol[5] do for I6 := i5 + 1 to iCol[6] do begin pItem := @ArItem[ic];
type OneItem = array[1..6] of Byte; var ArItem: array[0..33 * 32 * 31 * 30 * 29 * 28 div 720] of OneItem;
function Calc33a: Integer; var i1, i2, i3, i4, i5, i6: Byte; ic: Integer; i: Byte; iCol: OneItem; pItem: ^OneItem; begin
for I := 1 to 6 do begin iCol[i] := 27 + i; end;
ic := 0;
for I1 := 1 to iCol[1] do for I2 := i1 + 1 to iCol[2] do for I3 := i2 + 1 to iCol[3] do for I4 := i3 + 1 to iCol[4] do for I5 := i4 + 1 to iCol[5] do for I6 := i5 + 1 to iCol[6] do begin pItem := @ArItem[ic];
楼上的算法在我的电脑上跑0.89ms, 下面的优化算法在我的电脑上跑,0.37ms,如果还要快,要改汇编语言了。 type PUInt64=^UInt64; var BrItem: array [0 .. 33 * 32 * 31 * 30 * 29 * 28 div 720 - 1] of UInt64;
function Calc33b: Integer; var j1, j2, j3, j4, j5, j6,j7,j8: Byte; p: PUInt64; begin j7:=0; j8:=0; p:=@BrItem;
for j1 := 1 to 28 do for j2 := j1 + 1 to 29 do for j3 := j2 + 1 to 30 do for j4 := j3 + 1 to 31 do for j5 := j4 + 1 to 32 do for j6 := j5 + 1 to 33 do begin p^:=PUInt64(@j8)^; Inc(p); end;
type PUInt64 = ^UInt64; OneItemA = array[1..8] of Byte;
var ArItemA: array[0..iBuff - 1] of OneItemA;
function Calc33b: Integer; var j8, j7, j6, j5, j4, j3, j2, j1: Byte;
p: PUInt64; begin j8 := 0; j7 := 0; p := @ArItemA;
for j1 := 1 to 28 do for j2 := j1 + 1 to 29 do for j3 := j2 + 1 to 30 do for j4 := j3 + 1 to 31 do for j5 := j4 + 1 to 32 do for j6 := j5 + 1 to 33 do begin p^ := PUInt64(@j1)^; Inc(p); end;
Result := iBuff + j7 + j8; end;
----------------------------------------------
-
type PUInt64 = ^UInt64; OneItemA = array[1..8] of Byte;
var ArItemA: array[0..iBuff - 1] of OneItemA;
function Calc33b: Integer; var j8, j7, j6, j5, j4, j3, j2, j1: Byte;
p: PUInt64; begin j8 := 0; j7 := 0; p := @ArItemA;
for j1 := 1 to 28 do for j2 := j1 + 1 to 29 do for j3 := j2 + 1 to 30 do for j4 := j3 + 1 to 31 do for j5 := j4 + 1 to 32 do for j6 := j5 + 1 to 33 do begin p^ := PUInt64(@j1)^; Inc(p); end;
不搞大数组更快,更简单,0字节内存占用,运行时间平均不到0.1ms 算出任意位置的结果 function Calc33b(Index:Integer): UInt64; var j1, j2, j3, j4, j5, j6,j7,j8: Byte; begin if (Index<=0) or (Index>1107586) then Exit(0); j7:=0; j8:=0;
for j1 := 1 to 28 do for j2 := j1 + 1 to 29 do for j3 := j2 + 1 to 30 do for j4 := j3 + 1 to 31 do for j5 := j4 + 1 to 32 do for j6 := j5 + 1 to 33 do begin Dec(Index); if (Index=0) then Exit(PUInt64(@j8)^) end; end;
----------------------------------------------
-
type //注意这里OneItem数据类型定义的改动,每项数据长度从6字节改到8字节提升速度 OneItem = Record case integer of 0 : (U : UInt64); 1 : (data : array[1..6] of Byte); end; var ArItem: array[0..33 * 32 * 31 * 30 * 29 * 28 div 720] of OneItem;
function Calc33a: Integer; var R : UInt64; pItem: ^OneItem; begin pItem := @ArItem[0]; R :=$060504030201; repeat pItem.U := R; inc(PItem); if R > $210000000000 then if R > $212000000000 then if R > $21201f000000 then if R > $21201f1e0000 then if R > $21201f1e1d00 then if R = $21201f1e1d1c then break else begin var t : UInt64 := R and $ff; R := ((((t shl 8+t) shl 8+t)shl 8+t)shl 8+t)shl 8+t+$60504030201; end else begin var t : UInt64 := R and $ff00; R := (((t shl 8+t)shl 8+t)shl 8+t)shl 8+$50403020100+R and $ffff; end else begin var t : UInt64 := R and $ff0000; R := ((t shl 8+t)shl 8+t)shl 8+$40302010000+R and $ffffff; end else begin var t : UInt64 := R and $ff000000; R := (t shl 8 +t)shl 8+$30201000000+R and $ffffffff; end else R := R and $ff00000000 shl 8+$20100000000+R and $ffffffffff else R := R+$10000000000; until false; Result := 1107586; end;
----------------------------------------------
-
pOneItemG = ^OneItemG; OneItemG = record case integer of 0: (U: Int64); 1: (data: array[1..6] of Byte); end; var ArItemG: array[0..iBuff - 1] of OneItemG;
function Calc33g: Integer;
implementation
function Calc33g: Integer; var i1, i2, i3, i4, i5, i6: Int64; itmp2, itmp3, itmp4, itmp5: Int64; pItem: pOneItemG; begin pItem := @ArItemG;
for I1 := 1 to 28 do begin for I2 := i1 + 1 to 29 do begin itmp2 := i1 + i2 shl 8; for I3 := i2 + 1 to 30 do begin itmp3 := itmp2 + i3 shl 16; for I4 := i3 + 1 to 31 do begin itmp4 := itmp3 + i4 shl 24; for I5 := i4 + 1 to 32 do begin itmp5 := itmp4 + i5 shl 32; for I6 := i5 + 1 to 33 do begin pItem.U := itmp5 + i6 shl 40; inc(pItem); end; end; end; end; end; end;