庆五一，算法大比拼，放分大行动(300分)

凤冠坡 · 2006-04-29

Dos 下的算法：绝对最快！！

uses XCRT;
const Inter = 8;
Max = 16000;
var Number, M, I: LONGINT;
Magicgroup: array[1..14000] of LONGINT;
X, Y: BYTE;

function Getnumber(M: LONGINT): Boolean;
var I, N: LONGINT;
begin
N := ROUND(SQRT(M));
Getnumber := True;
I := 1;
repeat INC(I)
until (I = NUMBER) or (N < Magicgroup);
if N < Magicgroup then N := I;
begin N := I - 1
end;
for I := 1 to N do
if (M mod Magicgroup = 0) then
begin Getnumber := False
Exit
end
end;

begin CLOCKON;
Number := 1
X := GETX
Y := GETY;
Magicgroup[Number] := 2;
for I := 2 to Max do
begin if Getnumber(I) then
begin Number := Number + 1;
Magicgroup[Number] := I;
end
if I mod 1000 = 0 then
begin SETXY(X, Y)
Write(I: 6)
end;
end
BELL
WRITELN
CLOCKOFF
READLN;
for I := 1 to 100 do
begin {SETXY(10,1);} Write(Magicgroup: Inter);
end
Writeln(#13#10'总共:',
Number, #13#10'比率:',
Number / Max: 10: 7);
end.

wenyian0928 · 2006-04-29

不看不知道，一看吓一跳。

我把ak_2004的代码，抄了下来，随便优化了一下，时间是多少？0.08秒，牛人呀。

庆祝本贴浏览量超过500，呵呵。

vvyang · 2006-04-29

我的方法最快：
把1到100000所有的质数事先写在数组里，然后显示在 ListBox 中...
（...头部被榴莲击中）

chinawjy · 2006-04-29

基本上求质数用筛选法，空间换时间，速度很快。
倒是在for循环中ListBox1.Items.Add(inttostr(**))比较费时间。

chinawjy · 2006-04-29

to vvyang：
最快应该是整一个字符串，直接在listbox里面写。
其实楼主的题目出的让比起来不太科学，后面的显示一般都占了大头了。
算数反而不占时间。

zbird · 2006-04-30

我的机器1G DDR400 P42.66（羊D）
跑500,000的数
算法时间 157ms
拼接字符串的时间 641ms
显示到memo的时间 641ms
上面的时间都是从开始运算的时候算起的。
最花时间的地方就在拼接字符串的地方。
我的机器最多只能跑到这么大，设置成600,000就挂了[

]。

procedure TForm1.btn1Click(Sender: TObject);
var
it, i, j, len, c: Integer;
at: array of Integer;
str: string;
flag: Boolean;
vx: TDateTime;
begin
c := strtoint(edt1.text);
vx := Now;
SetLength(at, 1);//先放一个质数进去（2）
at[0] := 2;
len := High(at) + 1;
it := Trunc(Sqrt(c));
//有些数是不用验证的，要除只除质数
for i := 3 to c do//1、2就不用管了，从3开始
begin
flag := true;
for j := 0 to len - 1 do
begin
//大于这个数就不用除了
if at[j] > it then
begin
flag := true;
Break;
end;
//除成功了，不是质数，不管了
if i mod at[j] = 0 then
begin
flag := False;
Break;
end;
end;
//是质数，加进
if flag then
begin
len := len + 1;
SetLength(at, len);
at[len - 1] := i;
end;
end;
mmo2.Lines.Add(FormatDateTime('ss zzz', now - vx));
for i := 0 to len - 1 do
begin
str := str + IntToStr(at) + #13#10;
//str := str + 'vvvvvv' + #13#10;
end;
mmo2.Lines.Add(FormatDateTime('ss zzz', now - vx));
mmo1.Lines.BeginUpdate;
mmo1.Text := str;
mmo1.Lines.EndUpdate;
mmo2.Lines.Add(FormatDateTime('ss zzz', now - vx));
end;

zbird · 2006-04-30

哈哈，发现一个无敌的方法了。
在资源管理器中将进程的优先级调整成实时。
5,000,000（5百万）跑出来的数据
02s 797ms
02s 937ms
05s 859ms

10,000,000（一千万）跑出来的数据
06 984
07 250
14 281

程序跑起来的时候连任务管理器里的数据都刷新不了了[

]，强啊。
大家可以把自己的程序也这样跑了玩玩。

wenyian0928 · 2006-04-30

to zbird:
你说的好像不对，我测试了一下，根本没有效果，主要还是算法。
我把zk_2004的算法优化了一下，100000内，0.08秒。
进程的优先级调整成实时，或在程序中设置成实时，都还是0.08秒。

zbird · 2006-04-30

SetLength也要花费点时间。
我上面的程序现在是每出现一个新的质数就进行一次分配，可以在程序运行的最初期就分配好(count div 2)+1的空间（除去偶数，再多也多不过这个数[

]），这样算法部分还能更快一点点。不过就和chinawjy说的一样，怀疑楼主是不是在考求质数的算法啊。最花时间的地方是在显示部分。

TO wenyian0928
时间太短了，你可以改大点。
不过要注意的是，程序跑起来后连鼠标都动不了，机器就和死了一样。
你是无法结束任务的，只能重启机器。

DoubleWood · 2006-04-30

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ListBox1Data(Control: TWinControl
Index: Integer;
var Data: string);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
valueList: TList;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const
MAXP = 100000000;
var
PTable: array [0..MAXP] of Boolean;

procedure TForm1.Button1Click(Sender: TObject);
var
Freq, C1, C2, C3: Int64;
i, j, c: Integer;
begin
ListBox1.Count := 0;
valueList.Clear;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(C1);
PTable[0] := False;
for i := 1 to MAXP do
PTable := odd(i);
for I := 3 to trunc(Sqrt(MAXP)) do
begin
if not PTable then
Continue;

for j := i to MAXP div i do
begin
if not odd(j) then
Continue;
PTable[i*j] := False;
end;
end;

PTable[1] := False;
PTable[2] := True;
QueryPerformanceCounter(C2);

for i := 0 to MAxp do
begin
if PTable then
begin
valueList.Add(pointer(i));
end;
end;
ListBox1.Count := valueList.Count;

QueryPerformanceCounter(C3);
Caption := FloatToStr((C2-C1)/Freq)+'|'+FloatToStr((C3-C2)/Freq)+'|'+IntToStr(valueList.Count);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
Freq, C1, C2, C3: Int64;
i, c: Integer;
begin
ListBox1.Count := 0;
valueList.Clear;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(C1);
C := Prime.Primes.Count(0,MAXP);
QueryPerformanceCounter(C2);
for i := 1 to c do
valueList.Add(Pointer(Primes.Prime));
ListBox1.Count := valueList.Count;
QueryPerformanceCounter(C3);
Caption := FloatToStr((C2-C1)/Freq)+'|'+FloatToStr((C3-C2)/Freq)+'|'+IntToStr(valueList.Count);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
Freq, C1, C2, C3: Int64;
i,t,k: Integer;
begin
ListBox1.Count := 0;
valueList.Clear;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(C1);

k := trunc(Sqrt(MAXP));
for I := 0 to MAXP do
PTable := odd(i);
i := 3;
t := i*i;
repeat
while t<MAXP do
begin
PTable[t] := False;
t := t+i*2;
end;
repeat
inc(i);
until PTable;
t := i*i;
until t>=MAXP;
QueryPerformanceCounter(C2);
for i := 0 to MAxp do
begin
if PTable then
begin
valueList.Add(pointer(i));
end;
end;
ListBox1.Count := valueList.Count;
QueryPerformanceCounter(C3);
Caption := FloatToStr((C2-C1)/Freq)+'|'+FloatToStr((C3-C2)/Freq)+'|'+IntToStr(valueList.Count);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
valueList := TList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
valueList.Free;
end;

procedure TForm1.ListBox1Data(Control: TWinControl
Index: Integer;
var Data: string);
begin
Data := IntToStr(Integer(valueList[index]));
end;

其中Button2Click是最快的，不过我没有代码，只有DCU。
我的机器pm 1.4G, 1G ram，运行结果如下: (算法时间/显示时间/个数)
10000000:
B1 0.661544134799255|0.0810804166451323|664579
B2 0.0769919081894487|0.256501594476393|664579
B3 0.685574283882449|0.0778098892457002|664579
100000000:
B1 6.58712210630122|0.870264796224101|5761455
B2 0.23615515379748|1.24616340903662|5761455
B3 6.65917651545099|0.897416571100517|5761455

zjan521 · 2006-04-30

没有人测试我的代码?

显示有太多的方式可以加速,字符串的拼接更是大忌

DoubleWood · 2006-04-30

有阿，你的代码在我的机器上10000000条运算时间大概是1.5~1.6秒左右，慢了0.9秒左右

jeffrey_s · 2006-05-01

计算总数。忽略输出字符串。
const
MMax = 10000000;
var
B: array [0..MMax+1] of Boolean;

function CountPrimeNumber: Integer;
var
i, j: Integer;
begin
Result := 0;
FillChar(B, Sizeof(B), True);
for i := 2 to MMax div 2 do
B[i * 2] := False;
for i := 3 to Round(Sqrt(MMax)) do
if B then
for j := MMax div i downto i do
if B[j] then
B[j * i] := False;
for i := 2 to MMax do
if B then Inc(Result);
end;

DoubleWood · 2006-05-01

jeffrey_s的算法非常棒，速度又提高了1倍多，
不过在我的机器上
for i := 1 to MAXP do
PTable := odd(i);
要比
FillChar(B, Sizeof(B), True);
for i := 2 to MMax div 2 do
B[i * 2] := False;
稍微快上一些

DoubleWood · 2006-05-01

procedure TForm1.Button5Click(Sender: TObject);
const
CACHE = 64*1024;
STEMPEL: array[0..7] of Byte = (1, 7, 11, 13, 17, 19, 23, 29);
MODS: array[0..29] of Byte = (0, 1, 0, 0, 0, 0, 0, 2, 0, 0, 0, 4, 0, 8, 0, 0,
0, 16, 0, 32, 0, 0, 0, 64, 0, 0, 0, 0, 0, 128);
var
Freq, C1, C2, C3: Int64;
Primes, PrimesLUT: array of Byte;
i, j, k, PrimeLen, PrimeBits, Num, Num2, m, mbit, s: Cardinal;
begin
SetThreadPriority(GetCurrentThread,15);
ListBox1.Count := 0;
valueList.Clear;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(C1);
valueList.Add(pointer(2));
valueList.Add(pointer(3));
valueList.Add(pointer(5));
SetLength(PrimesLUT, Trunc(Sqrt(MaxP)/30)+1)
// max 2184 Byte für 2^32 ;-)
PrimesLUT[0]:=$01;
PrimeLen:=Length(PrimesLUT);
PrimeBits:=PrimeLen*30;
for i:=0 to Trunc(Sqrt(PrimeBits)/30) do
for j:=0 to 7 do
if PrimesLUT and (1 shl j)=0 then begin
s:=STEMPEL[j]

Num:=i*30+s

Num2:=Num*Num

mbit:=Num2 mod 30

m:=(Num2-mbit) div 30

while m<PrimeLen do begin
PrimesLUT[m]:=PrimesLUT[m] or MODS[mbit]

Inc(m, i)

Inc(mbit, s)

if mbit>29 then begin
Dec(mbit, 30);
Inc(m);
end

end

end

SetLength(Primes, CACHE)

PrimeLen:=Length(Primes);
PrimeBits:=PrimeLen*30;
for k:=0 to MaxP div PrimeBits do begin
FillChar(Primes[0], PrimeLen, 0)

for i:=0 to Trunc(Sqrt((k+1)*PrimeBits)/30) do
for j:=0 to 7 do
if PrimesLUT and (1 shl j)=0 then begin
s:=STEMPEL[j]

Num:=i*30+s

if k=0 then
Num2:=Num*Num
else
Num2:=Trunc(k*PrimeBits/Num)*Num+Num

mbit:=Num2 mod 30

m:=(Num2-mbit) div 30-k*PrimeLen

while m<PrimeLen do begin
primes[m]:=Primes[m] or MODS[mbit]

Inc(m, i)

Inc(mbit, s)

if mbit>29 then begin
Dec(mbit, 30)

Inc(m);
end

end

end

for i:=0 To PrimeLen-1 do
for j:=0 to 7 do begin
if k*PrimeBits+i*30+STEMPEL[j]>MaxP then
Break;
if not ((i=0) and (j=0) and (k=0)) and (Primes and (1 shl j)=0) then
valueList.Add(pointer(k*PrimeBits+i*30+STEMPEL[j]));
end;
end;
ListBox1.Count := valueList.Count;
QueryPerformanceCounter(C2);
Caption := FloatToStr((C2-C1)/Freq)+'|'+IntToStr(valueList.Count);
SetThreadPriority(GetCurrentThread,0);
end;
网上找到的一个比较怪异的算法，没看懂，主要在数据量大时有优势，省内存
在10000000时和jeffrey_s的算法相当，1亿时快40%左右，1000000及以下就慢很多了
找出2^31-1以内的质数在我机器上需要 34秒左右（只统计，不输出），其他算法内存不够用……[]

cnbell · 2006-05-01

对特别大的数字做费马测试。费马测试并不能确定它是否质数，但通过费马测试以后的数不是质数的概率微乎其微。下面是费马测试的细节：

－待测奇数 n
－在质数集合中依次选取一个质数 b ，b = 2,3,5,7......
－计算 w = b^(n-1) % n
－如果对于所有 b ，w都为1，n 很可能是质数。否则 n 一定是合数。

cjmcn-sh · 2006-05-02

真是牛人一系列~

zjan521 · 2006-05-02

从头仔细看了一下,其实似乎没有什么新意可言(单就算法而言).jeffrey_s的算法和我的没有什么大的差别.这其实也是大家能够直接想到的算法.
不过从中倒是学习了一些东西,以前没有太注意过代码效率的问题,其实并不是你的SOURCE有效率就一定BIN有效率,这个和很多东西有关,比如编译器.
从这篇帖子中学到的.
1.在不影响逻辑的情况下,尽量减少内存的占用.(比如这个帖子用相同的逻辑,结合位操作指令使用汇编实现,我想绝对比BOOLEAN+DELPHI的效率要高)(当然如果用了INTELC++编译器,再有双核超线程,这个就不好说了,可见汇编调优不是什么时候都合适)
2.尽量减少内存写.比如
//if(!pBoolArr[ulIndex])
pBoolArr[ulIndex] = TRUE;
这个if语句很可能会对你的代码效率有很大影响,(当然不是绝对,这要视乎你的数据的分布和使用概率),在这个帖子的计算素数中,因为在计算中基本上绝大部分都是合数,极少为素数,因此有没有if就很管用了,(原因就是CPU的内部缓存)
3.逆向思维很重要,这里指的仍然是尽量减少内存写.而有得看起来不一样的东西,其实效率可能没有什么差别,比如不同的寻址模式,很有可能指针操作和数组寻址差别不大.
4.我稍候会贴出ASM的代码,希望能够验证我上边的意思.

zjan521 · 2006-05-02

有一点想错了,位操作其实意义不一定大,主要是能够节省内存,但是因为很可能要有一个寻址的问题,倒不一定能够有所超越,

DoubleWood · 2006-05-03

大部分算法原理是一样的，都是筛法，但是在具体实现上还是有所不同。优化的关键在于如何减少循环的次数。
jeffrey_s算法就是成功的减少了很多的循环。
又比如我贴的Button5Click 里的算法，如果把所有类似
PrimeBits:=PrimeLen*30
这样的语句都改成
PrimeBits:=(PrimeLen*16-PrimeLen)*2
这样的语句，那么还会有速度10~20%的提升(在我的机器上)。
目前见到最快的应该是PrimeNumber.zip里的算法，但是没有源码，无法得知算法。
Delphi写的我见到最快的是Prime.dcu，作者同样没有提供源码，但是提供了声明部分，所以可可以在程序里调用，大约比jeffrey_s的算法快上几十倍。作者是Hagen Reddmann。著名的DEC（ Delphi Encryption Compendium ）的作者。
汇编肯定要比高级语言要快，前提是你的代码正确[

]，但是提升未必有想象中的高。很多时候，一个好的算法比用汇编重写的提升要来得快。

庆五一，算法大比拼，放分大行动(300分)

凤冠坡

Unregistered / Unconfirmed

wenyian0928

Unregistered / Unconfirmed

vvyang

Unregistered / Unconfirmed

chinawjy

Unregistered / Unconfirmed

chinawjy

Unregistered / Unconfirmed

zbird

Unregistered / Unconfirmed

zbird

Unregistered / Unconfirmed

wenyian0928

Unregistered / Unconfirmed

zbird

Unregistered / Unconfirmed

DoubleWood

Unregistered / Unconfirmed

zjan521

Unregistered / Unconfirmed

DoubleWood

Unregistered / Unconfirmed

jeffrey_s

Unregistered / Unconfirmed

DoubleWood

Unregistered / Unconfirmed

DoubleWood

Unregistered / Unconfirmed

cnbell

Unregistered / Unconfirmed

cjmcn-sh

Unregistered / Unconfirmed

zjan521

Unregistered / Unconfirmed

zjan521

Unregistered / Unconfirmed

DoubleWood

Unregistered / Unconfirmed

Similar threads