求一组合算法,800多万个组合,要求时间控制在0.5秒以下(C2.4G,512M),你们有多少个能够做到? ( 积分: 90 )

呵呵，关注一下

本机数值参考 SetLength> 0.0683 ,#0> 0.1951 ,#1> 0.1695 ,#2> 0.1289 ,#3> 0.1618
SetLength> 0.0684 ,#0> 0.1945 ,#1> 0.1688 ,#2> 0.1342 ,#3> 0.1577

空循环消耗时间 : 0.04
思路1: 0.15
思路2：0.15

一：
TDataR = packed record
case Integer of
0: (res: int64);
1: (Data: array[0..7] of Byte)
//保证位对齐
end;
var
Data : array of TData;
i1..i8 : byte;
i : ^Int64;
begin
Setlength();
k := 0;
i := @i8
// 在我的机器，变量顺序在内存中反了过来。
for (...) do
begin
Data[k].res := i^;
inc(k);
end;

二 ： 使用delphi的 absolute 关键字。效果和方法一差不多。

i1, i2, i3, i4, i5, i6, i7, i8: byte;

d1: Int64 absolute i1;
d2: Int64 absolute i2;
d3: Int64 absolute i3;
d4: Int64 absolute i4;
d5: Int64 absolute i5;
d6: Int64 absolute i6;
d7: Int64 absolute i7;
d8: Int64 absolute i8;
begin
...
Data[k].res := d8;
...
end;


但是，如果 将复制语句改成 Data[k].res := d6, 运行速度为0.07左右 。

对应的汇编,int64是8个byte，在32位机器上面需要复制2次

赋值d8，总运行时间0.15
mov ecx,[ebp-$08]
mov [eax + edx*8],ecx
mov ecx,[ebp-$04]
mov [eax + edx*8 + $04],ecx

赋值d6,总运行时间0.07
mov ecx,[ebp-$06]
mov [eax + edx*8],ecx
mov ecx,[ebp-$02]
mov [eax + edx*8 + $04],ecx

可能是cpu在做mov操作的时候，有些什么特殊处理，具体原因待查。


三，思路only。
1.减少赋值语句运行次数
1. mov指令一次是赋值4个byte，因为现在是只用到7个byte，所以实际上2次赋值(8bytes)就会浪费掉一个byte的位置，如果能利用起来的话，速度能提升约1/7。
2. 使用movsX 指令,一次赋值一段内存，对应的函数有move函数(movsd)和 字符串的复制操作(movsb)。 唔。。排列组合的结果，很多位都是重复的。。

2.减少循环运行次数
1. 从数学上入手，组合[1-18]和[19-36]的组合情况应该是一致的。

To qqjm你到底能不能读懂Delphi代码呢
//writeln(Format('%.8d: %.2d;%.2d;%.2d;%.2d;%.2d;%.2d;%.2d',
// [Count, I1,I2,I3,I4,I5,I6,I7]));

使用内存移动以及内存填充的方法，
D[1..7] of array of byte
//结果保存数组
st[1..7] //填充起始位置
k[1..7] //待填充字节个数
s[1..36] = (1,2,3,4,5...34,35,36);

内层循环代码如下

for i5 := i4 + 1 to 34 do
begin
for i6 := i5 + 1 to 35 do
begin
// for i7 := i6+1 to 36 do
k[7] := 36 - (i6 + 1);
MoveMemory(@D[7][st[7]], @s[i6 + 1], k[7]);
inc(st[7], k[7]);
// end of i7 loop.
k[6] := st[7] - st[6];

FillMemory(@D[6][st[6]], k[6], i6);

st[6] := st[7];
end;
k[5] := st[6] - st[5];
FillMemory(@D[5][st[5]], k[5], i5);
st[5] := st[6];
end;

代码不算复杂，原理还是很好懂的。
测试结果 ：非常不理想。 MoveMemory以及FillMemory这2个内存操作函数的效率不尽人意，继续寻找更高效的内存操作方法。

呵呵，不是函数的问题，而是不应该在最内层循环这么敏感的地方调用任何函数。因为
函数调用的机器码call以及ret都要占用不少的CPU周期，远远赶不上直接内存赋值。

http://hjsoft2006.27h.com/p36.rar
新写的 速度快了 0。1秒 以下

下载不了

我可以下载啊

hjsoft2006兄的代码在我的机器上显示的执行速度为0.03秒——简直匪夷所思啊。如果我
的判断还正确的话，用简单的分配内存块并嵌套循环填值绝对不可能有如此大的提高。刚好
我前几天想过另一种方法——并不真正填值，而只是在显示的过程中计算第N个组合的第X个
数字，显示给用户——使用这种“仅在被看到时计算”的技术后，组合的速度在用户看起来
是相当快的——因为实际上只需要计算出组合的总数，设置StringGrid的行数，然后，就仅
仅需要在StringGrid的相应事件中编写代码，为其填充组合值而已。我想，只有采用动态计
算技术，才有可能让组合的速度（看起来）有数量级的提升。
为了验证我的想法，我用DeDe对hjsoft2006的Exe代码进行了反编译。另外，我还通过在
Delphi环境下Attach该进程进行动态跟踪以了解它的真正算法。
果然，在ListBox的Click事件中，只是简单的计算出了组合数而已，虽然其内也使用了
SetLength分配空间，但其长度甚至还要小于组合数的数量，至于多重循环填充内存区块更
加是无从谈起了。但是，在StringGrid的DrawCell事件中，我发现它多次的调用了用于计算
组合数（C(N,M)）的过程——很显然，它在根据当前的行号计算组合中每一位的实际数值，
而这一切都发生在点击ListBox之后。p36.exe利用将真正的组合计算推迟到StringGrid行的
显示事件，从而达到了提速的效果（也仅仅是效果而已）。

谜团已经解开，这是一个聪明的策略——让计算仅仅发生在应该被计算的时候。
当然，如果我们试图一次性一条不漏的获得全部组合的元素内容（例如，将全部组合输出
到文件中），这种对每行进行独立组合计算的方法反而会更加耗时（因为每个组合都要将所
有的变量重新初始化）。

creation-zy 说的很对
其实 我故意 分配了 内存 来 延迟一下 时间
// 开了个 小玩笑而已 ：)

因为 不延时 就是 0 秒了
我稍候 贴出 代码


unit Unit33;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
ListBox1: TListBox;
Panel1: TPanel;
Panel2: TPanel;
StringGrid1: TStringGrid;
Label1: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject
ACol, ARow: Integer;
Rect: TRect
State: TGridDrawState);
procedure FormActivate(Sender: TObject);
private
now_m, now_n: integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function getc(m, n: integer): integer;
var
i: integer;
begin
Result := m;
for i := 2 to n do
begin
Result := Result * (m - i + 1);
Result := Result div i;
end;

end;

function getstrbyidx(m, n, idx: integer): string;
var
oldi, i, s_idx: integer;
c, c1, now_m, now_n, now_idx: integer;
begin
Result := '';
now_m := m;
now_n := n;
now_idx := idx;
oldi := 0;
for s_idx := 1 to n do
begin
c1 := 0;

if s_idx = n then
begin
Result := Result + ', ';
Result := Result + IntToStr(oldi + now_idx);
end
else
for i := 1 to now_m - now_n + 1 do
begin
c := getc(now_m - i, now_n - 1);
if c1 + c >= now_idx then
begin
if s_idx > 1 then
Result := Result + ', ';
Result := Result + IntToStr(oldi + i);
oldi := oldi + i;
now_idx := now_idx - c1;
now_n := now_n - 1;
now_m := now_m - i;
Break;
end;
c1 := c1 + c;
end;


end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
m, n: integer;
begin
Caption := 'qq:253377572';
for m := 36 downto 20 do
for n := 7 downto 5 do
ListBox1.Items.Add(Format('%d 选 %d', [m, n]));
now_m := 36;
now_n := 7;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
i, m, n: integer;
s: string;
b: DWORD;
begin
i := ListBox1.ItemIndex;
if i < 0 then
exit;
b := GetTickCount;
s := ListBox1.Items;
Label1.Caption := s;

m := StrToInt(s[1] + s[2]);
n := StrToInt(s[length(s)]);
now_m := m;
now_n := n;
StringGrid1.RowCount := getc(m, n) + 1;
if StringGrid1.Row <> 1 then
StringGrid1.Row := 1;
StringGrid1.Repaint;



Label2.Caption := '共' + IntToStr(getc(m, n)) + '条 ' + FormatFloat('0.000', (GetTickCount - b) / 1000) + '秒';
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject
ACol, ARow: Integer;
Rect: TRect
State: TGridDrawState);
begin
if ARow > 0 then
begin
if ACol = 0 then
StringGrid1.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3, IntToStr(ARow))
else
StringGrid1.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3, getstrbyidx(now_m, now_n, ARow {}));

end
else
begin
end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
ListBox1.ItemIndex := 0;
ListBox1.OnClick(ListBox1);
end;

end.



object Form1: TForm1
Left = 192
Top = 107
BorderStyle = bsSingle
Caption = 'qq:253377572'
ClientHeight = 273
ClientWidth = 561
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnActivate = FormActivate
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 12
object ListBox1: TListBox
Left = 440
Top = 0
Width = 121
Height = 273
Align = alRight
ItemHeight = 12
TabOrder = 0
OnClick = ListBox1Click
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 440
Height = 273
Align = alClient
BevelOuter = bvLowered
Caption = 'Panel1'
TabOrder = 1
object Panel2: TPanel
Left = 1
Top = 1
Width = 438
Height = 32
Align = alTop
BevelOuter = bvNone
TabOrder = 0
object Label1: TLabel
Left = 6
Top = 10
Width = 54
Height = 12
Caption = '.........'
end
object Label2: TLabel
Left = 80
Top = 10
Width = 54
Height = 12
Caption = '.........'
end
end
object StringGrid1: TStringGrid
Left = 1
Top = 33
Width = 438
Height = 239
Align = alClient
ColCount = 2
DefaultColWidth = 48
DefaultRowHeight = 17
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSelect]
TabOrder = 1
OnDrawCell = StringGrid1DrawCell
ColWidths = (
48
349)
end
end
end

[][]

佩服佩服。
不同的方法分配内存，所需时间不同。利用位运算将整数组合起来，减少赋值的次数也能提高速度。
没想到一个简单的问题，仔细研究起来学问还是很大的。

自由灵活，所见即所得的表格组件，开发环境下设计表格内容，独有的单据和Excel两种界面风格，可设计出各种类型的界面，配合强劲的打印功能，轻松解决自由界面和报表难题。其显著特性包括：
. 提供了单据， Excel ，Grid 三种界面风格。
. 开发环境下设计表格，所见即所得。
. 支持数据库和分组。
. 既可以作为普通表格使用，又可以作为数据感知组件使用，或者两者同时使用。
. 独特的双数据源连接，轻松实现单记录布局和主从表连接。
. 除了通过数据集本身的方法来访问数据库的记录之外，还可以通过读取单元格的Text属性来实现，这样就不 必在数据集间来回移动记录。
. 支持unicode文本。
. 提供了列排序，移动行列，隐藏行列，增删行列等功能。
. 提供了 Excel 样式的过滤功能。
. 方便的查找对话框。
. 提供了单元格合并，单元格命名，只读单元格，锁定单元格等功能。
. 提供了列对象，用于控制整列单元格。
. 支持虚表，公式(包括自定义公式)， RTF 格式文本，Ole 对象和图表。
. 提供了按钮、下拉框、复选框、单选钮、日期、超链接、数值类等多种输入方式。
. 支持整形、正整形、负整形、浮点数、正浮点数、负浮点数等输入方式。可自动处理千分位，可设置小数位 数。
. 九种文本和图形对齐方式，还可通过单元格边距控制输出位置。
. 导入/导出 Excel 文件，相互粘贴数据。
. 提供了自动调整行高，垂直文本输出功能。
. 可以设置单元格掩码，附有掩码编辑器。
. 设置单元格的 PasswordChar。
. 单元格内容字符数限制。
. 单元格支持图形，并且可以拉伸，层叠图形。
. 可以显示/隐藏单元格的边框、可以设置边框的类型、大小、颜色。
. 支持单元格斜线。
. 3D 外观的单元格。
. 设置单元格的光标和提示。
. 支持自绘画单元格。
. 设置固定行和列。
. 保存到文件和流。
. 提供了复制/粘贴区域功能。
. VCL 版本可以插入其它可视 VCL 组件。

http://www.anylib.com

新算法，将组合速度提高到了0.138秒
（执行环境：Intel(R) Pentium(R) M processor 1400MHz 1.25G内存）
耗时(秒): SetLength*3> 0.1065 #0.5> 0.0004 #1.0> 0.1380 #0.5+1.0> 0.1384
耗时(秒): SetLength*3> 0.1070 #0.5> 0.0004 #1.0> 0.1370 #0.5+1.0> 0.1374
耗时(秒): SetLength*3> 0.1065 #0.5> 0.0004 #1.0> 0.1388 #0.5+1.0> 0.1392
耗时(秒): SetLength*3> 0.1071 #0.5> 0.0004 #1.0> 0.1373 #0.5+1.0> 0.1377
耗时(秒): SetLength*3> 0.1062 #0.5> 0.0004 #1.0> 0.1380 #0.5+1.0> 0.1384
耗时(秒): SetLength*3> 0.1072 #0.5> 0.0004 #1.0> 0.1392 #0.5+1.0> 0.1396
耗时(秒): SetLength> 0.1070 #0> 0.2688 #1> 0.1621 #2> 0.1436 #3> 0.1963
耗时(秒): SetLength> 0.1063 #0> 0.2641 #1> 0.1615 #2> 0.1453 #3> 0.2005
耗时(秒): SetLength> 0.1060 #0> 0.2652 #1> 0.1606 #2> 0.1435 #3> 0.1965
耗时(秒): SetLength> 0.1068 #0> 0.2701 #1> 0.1608 #2> 0.1447 #3> 0.1978
耗时(秒): SetLength> 0.1061 #0> 0.2634 #1> 0.1608 #2> 0.1451 #3> 0.1959
耗时(秒): SetLength> 0.1061 #0> 0.2644 #1> 0.1605 #2> 0.1433 #3> 0.1983

提速了大约 4% ...


新算法将排列组合分成了后4位与前4位两个阶段，减少了内循环中的运算以及赋值次数。

procedure TForm1.Button2Click(Sender: TObject);
type
TData=packed record
case Integer of
0: (
IntData:Integer;
Ext1,Ext2,Ext3:Byte;
);
1: ( Bytes:array[0..6]of Byte );
2: (
B1,B2,B3:Byte;
IntData2:Integer
)
end;
TData2=packed record
case Integer of
0: (IntData:Integer;
1: (B0,B1,B2,B3:Byte)
end;
var
i,m:Integer;
i1,i2,i3,i4:Byte;
j,s,e:Integer;
Data:array of TData;
Data2:array of TData2;
StartPos:array of Integer;
pData:^TData;
Frq,tx,ty,t,t0,t1,t2,t3:Int64;
begin
QueryPerformanceFrequency(Frq);
QueryPerformanceCounter(tx);
{GetMem(Data,8347680*SizeOf(TData));
GetMem(Data2,40920*SizeOf(TData2));}
SetLength(Data,8347680);
SetLength(Data2,40920);
SetLength(StartPos,36);
QueryPerformanceCounter(ty);
t:=ty-tx
//Time for GetMem
{ #0.5 计算最后4位组合 —— 4..36中取4个数的组合 }
i:=0;
for i1:=4 to 33 do
begin
StartPos[i1]:=i
//记下倒数第4个数字的取值与Data2中的数据分布位置的关系
for i2:=i1+1 to 34 do
for i3:=i2+1 to 35 do
for i4:=i3+1 to 36 do
begin
with Data2 do
begin
B0:=i1;
B1:=i2;
B2:=i3;
B3:=i4;
end;
Inc(i);
end;
end;
StartPos[34]:=i;
QueryPerformanceCounter(tx);
//ShowMessage(IntToStr(i));
t0:=tx-ty;
{ #1.0 计算前4个组合，在内部嵌套后4个组合 }
i:=0;
for i1:=1 to 30 do
for i2:=i1+1 to 31 do
for i3:=i2+1 to 32 do
for i4:=i3+1 to 33 do
begin
//注意，i4要放在顶端高位，因为它是左右两个Integer的重叠部分，不能错了
m:=(i4 shl 24) or (i3 shl 16) or (i2 shl 8) or i1

s:=StartPos[i4];
e:=StartPos[i4+1]-1;
for j:=s to e do //如果不用中间变量s,e，Delphi的循环会出现问题??!!
begin
with Data do
begin
IntData:=m
//写前4 Byte
IntData2:=Data2[j].IntData
//写后4 Byte ——有重叠
end;
Inc(i);
end;
end;
QueryPerformanceCounter(ty);
t1:=ty-tx;
Memo1.Lines.Add(Format('耗时(秒): SetLength*3> %.4f #0.5> %0.4f #1.0> %.4f #0.5+1.0> %.4f',[t/Frq,t0/Frq,t1/Frq,(t0+t1)/Frq]));
{FreeMem(Pointer(Data))
Pointer(Data):=nil;
FreeMem(Pointer(Data2))
Pointer(Data2):=nil;}
SetLength(Data,0);
SetLength(Data2,0);
SetLength(StartPos,0);
end;

有必要嘛!!!
印度人写代码与我们写代码就是不一样,目前计算机处理器的速度应该让我更多去关心业务的应用,而不是速度!

根据mentoro兄的逻辑来演绎，在有了汽车等带步工具后，奥运会就不用举办了？

更多关心业务逻辑——没错，但也没说完全不关心算法的效率啊。偶尔抽空研究一下如何
提高效率又有何不可呢？再说，对于彩票问题，排列组合就是它的核心“业务应用”，难道
优化业务应用也错了？！

谈到业务逻辑——在我看来，所有用手工编写的代码来实现业务逻辑的系统都是时候入土
了——就让老夫来演一把终结者的角色吧，嘿嘿！ []

不错，不错.
不过，弱弱的问一句，你们的算法是给出了所有的排列吗？３７选７貌似是有顺序的吧.

我的机器 0.0063-0.0078s 应该再没什么讨论的了吧 最快的就是指针
procedure TForm4.Button2Click(Sender: TObject);
var
iLength: integer;
i1, i2, i3, i4, i5, i6, i7: Byte;
time: DWORD;
p: pointer;
pbByte;
begin
time := GetTickCount;
ilength := 8347680;
p := GetMemory(iLength * 7);
pb := p;
for i1 := 1 to 30 do
for i2 := i1 + 1 to 31 do
for i3 := i2 + 1 to 32 do
for i4 := i3 + 1 to 33 do
for i5 := i4 + 1 to 34 do
for i6 := i5 + 1 to 35 do
for i7 := i6 + 1 to 36 do
begin
Pb^:= i1
Inc(Pb);
Pb^:= i2
Inc(Pb);
Pb^:= i3
Inc(Pb);
Pb^:= i4
Inc(Pb);
Pb^:= i5
Inc(Pb);
Pb^:= i6
Inc(Pb);
Pb^:= i7
Inc(Pb);
end;
time := GetTickCount - time;
Edit2.Text := '用时：' + IntToStr(Time) + 'ms';
freeMem(p, iLength * 7);
end;

Unit4.pas.61: with pData^ do begin
004A643E 8BC1 mov eax,ecx
Unit4.pas.62: data[0] := i1;
004A6440 0FB65DF4 movzx ebx,[ebp-$0c]
004A6444 8818 mov [eax],bl
Unit4.pas.63: data[1] := i2;
004A6446 0FB65DF0 movzx ebx,[ebp-$10]
004A644A 885801 mov [eax+$01],bl
Unit4.pas.64: data[2] := i3;
004A644D 0FB65DEC movzx ebx,[ebp-$14]
004A6451 885802 mov [eax+$02],bl
Unit4.pas.65: data[3] := i4;
004A6454 0FB65DE8 movzx ebx,[ebp-$18]
004A6458 885803 mov [eax+$03],bl
Unit4.pas.66: data[4] := i5;
004A645B 0FB65DE4 movzx ebx,[ebp-$1c]
004A645F 885804 mov [eax+$04],bl
Unit4.pas.67: data[5] := i6;
004A6462 8BDE mov ebx,esi
004A6464 885805 mov [eax+$05],bl
Unit4.pas.68: data[6] := i7;
004A6467 885006 mov [eax+$06],dl
Unit4.pas.70: inc(pData);
004A646A 83C107 add ecx,$07
Unit4.pas.71: end;
004A646D 42 inc edx


Unit4.pas.98: Pb^ := i1
Inc(Pb);
004A65DE 0FB64DF7 movzx ecx,[ebp-$09]
004A65E2 880E mov [esi],cl
004A65E4 46 inc esi
Unit4.pas.99: Pb^ := i2
Inc(Pb);
004A65E5 0FB64DF6 movzx ecx,[ebp-$0a]
004A65E9 880E mov [esi],cl
004A65EB 46 inc esi
Unit4.pas.100: Pb^ := i3
Inc(Pb);
004A65EC 0FB64DF5 movzx ecx,[ebp-$0b]
004A65F0 880E mov [esi],cl
004A65F2 46 inc esi
Unit4.pas.101: Pb^ := i4
Inc(Pb);
004A65F3 0FB64DF4 movzx ecx,[ebp-$0c]
004A65F7 880E mov [esi],cl
004A65F9 46 inc esi
Unit4.pas.102: Pb^ := i5
Inc(Pb);
004A65FA 0FB64DF3 movzx ecx,[ebp-$0d]
004A65FE 880E mov [esi],cl
004A6600 46 inc esi
Unit4.pas.103: Pb^ := i6
Inc(Pb);
004A6601 8806 mov [esi],al
004A6603 46 inc esi
Unit4.pas.104: Pb^ := i7
Inc(Pb);
004A6604 8816 mov [esi],dl
004A6606 46 inc esi

mov [eax+$02],bl
比
mov [esi],cl inc esi
慢多了

to yyimen:你后面的那些代码如何理解?

后面的代码是进入CPU调试状态时IDE所显示出来的Delphi代码与机器码的对应关系。

唉！反正在我的机器上， Pointer^ 操作比数组慢好几倍，这个神奇效果我是没有福气看
到了……

等等——在我的机器上，Inc(Pb)生成的机器码是 FF06 inc dword ptr [esi] 而非
yyimen兄的 06 inc esi ——难道编译器不一样？（我的是Delphi 7 SP1，打开优化）

附上我的 Pb^ := i1
Inc(Pb)
对应的机器码：
00450F34 8B0E mov ecx, [esi]
00450F36 8A5DF7 mov bl, byte ptr [ebp-$09]
00450F39 8819 mov [ecx], bl
00450F3B FF06 inc dword ptr [esi]