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

我也来一个ASM版:
在我的电脑上100000需要0.6秒左右, P4 2.6, 单512M

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
APrime: string = '';
MaxValue: DWORD = 100000;
procedure WritePrime(iPrime: Integer);
begin
APrime:=APrime+IntToStr(iPrime)+#13#10;
end;
function GetPrime(): Boolean;
asm
PUSH EBX
PUSH EDI
mov eax, 2
call WritePrime
mov eax, 3
call WritePrime
mov edi, 5
@@While_MaxValue:
mov eax, edi
cmp eax, [MaxValue]
jnbe @@End_While_MaxValue
mov ebx, 3
@@While_Factor:
mov eax, ebx
mul eax
jo @@End_While_Factor
cmp eax, edi
jnb @@End_While_Factor
mov eax, edi
mov edx, 0
div ebx
cmp edx, 0
je @@End_While_Factor
add ebx, 2
jmp @@While_Factor
@@End_While_Factor:
je @@End_If
mov eax, edi
call WritePrime
@@End_If:
mov eax, edi
add eax, 2
mov edi, eax
jmp @@While_MaxValue
@@End_While_MaxValue:
mov eax, 1
POP EDI
POP EBX
end;
procedure TForm1.Button1Click(Sender: TObject);
var
lInt, lsTime, leTime: Int64;
begin
try
APrime:='';
QueryPerformanceFrequency(lInt);
QueryPerformanceCounter(lsTime);
if GetPrime() then ListBox1.Items.Text:=APrime;
QueryPerformanceCounter(leTime);
ShowMessage(Format('完成时间(秒)：%.10f', [(leTime-lsTime) / lInt]));
except
ShowMessage('计算错误！！！');
end;
end;
end.

见者有分。。。

再来一个Thread版:
在我的电脑上100000需要0.3秒左右, 500000需要1.8秒左右
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const
BlockSize = 500;
MaxValue = 500000;

var
APrime: array of string;
iComplete: Integer = 0;

procedure WritePrime(iPrime, iIndex: Integer);
begin
APrime[iIndex]:=APrime[iIndex]+IntToStr(iPrime)+#09;
end;

type
TPrimeHread = class(TThread)
private
Factor, FMin, FMax, FIndex: LongWord;
protected
procedure Execute
override;
public
constructor Create(iMin, iMax, iIndex: LongWord);
end;

constructor TPrimeHread.Create(iMin, iMax, iIndex: LongWord);
begin
inherited Create(False);
FMin:=iMin;
FMax:=iMax;
FIndex:=iIndex;
APrime[FIndex]:='';
FreeOnTerminate:=True;
end;

procedure TPrimeHread.Execute;
begin
try
if FMin = 1 then
begin
WritePrime(2, FIndex);
WritePrime(3, FIndex);
FMin:=5;
end;
while ( FMin <= FMax ) do
begin
Factor := 3;
while (Factor * Factor < FMin) and (FMin mod Factor <> 0 ) do
Factor := Factor + 2;
if FMin mod Factor <> 0 then WritePrime(FMin, FIndex);
FMin := FMin + 2;
end;
finally
Inc(iComplete);
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
i, HCount, StarValue: DWORD;
lInt, lsTime, leTime: Int64;
begin
try
Memo1.Clear;
iComplete:=0;
HCount:=MaxValue div BlockSize;
if (MaxValue mod BlockSize > 0) then Inc(HCount);
SetLength(APrime, HCount);
QueryPerformanceFrequency(lInt);
QueryPerformanceCounter(lsTime);
for i:=0 to HCount-1 do
begin
StarValue:=i*BlockSize;
TPrimeHread.Create(StarValue+1, StarValue+BlockSize, i);
end;
while HCount > iComplete do begin end;
Memo1.Lines.BeginUpdate;
for i:=0 to HCount-1 do Memo1.Lines.Add(APrime);
Memo1.Lines.EndUpdate;
QueryPerformanceCounter(leTime);
APrime:=nil;
ShowMessage(Format('完成时间(秒)：%.10f', [(leTime-lsTime) / lInt]));
except
ShowMessage('计算错误！！！');
end;
end;

end.

我见过最快的1000000条,仅需0.000001秒左右VC编写,算法相当好,
而我的Thread版需要3.6秒左右

顶一下

牛人。

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
ListBox1: TListBox;
Edit2: TEdit;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Edit1Enter(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
An:TStringList;
i:Integer;
MaxVal:Integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text := FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz', Now);
An.Add('1');
An.Add('2');
An.Add('3');
i:=3;
while i<MaxVal-1 do
begin
i:=i+2;
if i mod 3 >0 then
An.Append(inttostr(i));
end
// while

ListBox1.items:=An;
Edit3.Text := FormatDateTime('yyyy-mm-dd hh:nn:ss:zzz', Now);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
An:=TStringList.Create ;
end;

procedure TForm1.Edit1Enter(Sender: TObject);
begin
MaxVal:=strtoint(edit1.Text );
end;

说明：Edit1开始运算前放入数据100000

运行输入的整数不管多大都可以很快计算

procedure TForm1.Button1Click(Sender: TObject);
var ms:string;
mwa:array [1..400] of word
{ sqrt(100000)=313 }
mw1,mw2,mw3:word;
ml:longint;
mb:boolean;
begin
LabelStartTime.Caption:=FormatDateTime('hh:nn:ss.zzz',now);
mw1:=0;
mw2:=Round(sqrt(100000));
ms:='';
for ml:=2 to 100000 do begin
mb:=False;
for mw3:=1 to mw1 do if (ml mod mwa[mw3])=0 then begin
mb:=true;
break;
end;
if mb then continue;
ms:=ms+IntToStr(ml)+#13;
if ml<mw2+2 then begin
inc(mw1);
mwa[mw1]:=ml;
end;
end;
ListBox1.Items.Text:=ms;
LabelEndTime.Caption:=FormatDateTime('hh:nn:ss.zzz',now);
end;

p4 1.7 256M
约 1 秒 ,四次测试结果:
17:57:51.937 - 17:57:52.781
18:02:17.671 - 18:02:18.640
18:02:32.687 - 18:02:33.625
18:02:43.843 - 18:02:44.781

P43.0G 1GRAM
[TOTAL NUM : 100,000个] [TOTAL TIME : 0秒] [TOTAL COUNT : 9592个]
[TOTAL NUM : 500,000个] [TOTAL TIME : 0.0150000443682075秒] [TOTAL COUNT : 41538个]//这个不太稳定，有的时候到0.03秒,应该还是数量太小
[TOTAL NUM : 1,000,000个] [TOTAL TIME : 0.0469998456537724秒] [TOTAL COUNT : 78498个]
[TOTAL NUM : 5,000,000个] [TOTAL TIME : 0.328000006265938秒] [TOTAL COUNT : 348513个]
[TOTAL NUM : 10,000,000个] [TOTAL TIME : 0.702999858185649秒] [TOTAL COUNT : 664579个]
[TOTAL NUM : 50,000,000个] [TOTAL TIME : 3.90599998645484秒] [TOTAL COUNT : 3001134个]


//*****************************************************************************
//代码
//lbPrimeList.Style := lbVirtual;

type
__VIRTUAL_INTEGER_ARR = Array[0..$20000000-2] of Integer;
__PVIRTUAL_INTEGER_ARR = ^__VIRTUAL_INTEGER_ARR;
procedure CalcPrime(maxNUM : DWORD
primeList : TList);
var
maxValA : Integer;
valA : DWORD;
pValArr : __PVIRTUAL_INTEGER_ARR;

pVA : PINT;
pVB : PINT;
nVB : Integer;
begin
maxValA:= Trunc(Sqrt(maxNUM));
pValArr:= VirtualAlloc(nil, (maxNUM+1)*4, MEM_RESERVE + MEM_COMMIT, PAGE_READWRITE);

pValArr[0] := -1
pValArr[1] := -1;

for valA:= 2 to maxValA do
begin
pVA := @pValArr[valA];
if pVA^=0 then
begin
pVB := PINT(DWORD(pValArr) + valA * valA * 4);
for nVB := valA to (maxNUM div valA ) do
begin
Inc(pVB^);
pVB := PINT(DWORD(pVB) + valA * 4);
end;
end;
end;

for valA:= 2 to maxNUM do
if pValArr[valA]=0 then
primeList.Add(Pointer(valA));

VirtualFree(pValArr, 0, MEM_RELEASE);
end;

var
primeList : TList;

procedure TForm1.btnCalcClick(Sender: TObject);
var
maxNUM : Integer;
ErrCode : Integer;

time_1, time_2, time_span: TTime;
begin
Val(leMaxNUM.Text, maxNUM, ErrCode);
if ErrCode <> 0 then
begin
ShowMessage('Error Input of MaxNUM!');
leMaxNUM.Text := '';
leMaxNUM.SetFocus();
end;

primeList.Clear;
primeList.Capacity := MaxNUM + 1;

time_1:= Now();
CalcPrime(MaxNUM, primeList);
time_2:= Now();
time_span:= time_2 - time_1;
memoLOG.Text := '[TOTAL NUM : ' + IntToStr(maxNUM) + '个] [TOTAL TIME : ' + FloatToStr(time_span*24*3600) + '秒] [TOTAL COUNT : ' + IntToStr(primeList.Count) + '个]';

lbPrimeList.Count := primeList.Count;
end;

procedure TForm1.lbPrimeListData(Control: TWinControl
Index: Integer;
var Data: string);
begin
if lbPrimeList.Count<>primeList.Count then
begin
lbPrimeList.Count := primeList.Count;
exit;
end;
Data:= IntToStr(Integer(primeList[Index]));
end;

initialization
primeList:= TList.Create();
finalization
FreeAndNil(primeList);
end.

//来自：luzhouman, 时间：2006-4-28 16:01:04, ID：3429891
//我见过最快的1000000条,仅需0.000001秒左右VC编写,算法相当好,
//而我的Thread版需要3.6秒左右
这个恐怕是忽悠吧,查表还差不多.0.000001秒什么概念?根本就没概念.这个和0秒是一样的.(考虑误差).

to zjan521
http://www.freewebs.com/maths/download/PrimeNumber.zip

虽然是简单的一个算法，但对于我们交流非常棒，不是吗？
我们程序员不是木讷和死板的

上面我看到使用汇编写核心算法，使用多线程实现，使用数组、动态链表、TList保存等方法，对自己启发很大
希望大家有更多的算法或者更巧妙的实现方法：）

procedure TForm1.Button2Click(Sender: TObject);
const MAX_COUNT = 100000;
var
i ,j,k,ntime : integer;
s : string;
arrData : array[1..MAX_COUNT] of boolean;
begin
ntime := gettickcount;
fillchar(arrData,sizeof(arrData),true);
for i := 2 to trunc(sqrt(MAX_COUNT)) do
for j := i to trunc((MAX_COUNT)/2) do
begin
if i * j > MAX_COUNT then break;
arrData[i*j] := false;
end;

k:= 0
s := '';
ListBox1.Items.BeginUpdate;
for i:= 2 to MAX_COUNT do
begin
if arrData then begin
s := Format('%s%d , ', [s, i]);
inc(k);
if (s <> '') and (((k mod 10)=0) or (i=MAX_COUNT)) then begin
ListBox1.Items.Add(s);
s := '';
end;
end;
end;
if s <> '' then ListBox1.Items.Add(s);
ListBox1.Items.EndUpdate;
showmessage(inttostr(gettickcount- ntime));
end;

领教了，佩服

to muhx
昨天哪个错误还是出现了，我今天仔细看了下，在第二次运行时，传的Application参数出问题了，也就是说两次传入的Application参数不一样
注：第二次传入的appliaction参数中appliaction.mainform := nil;

to:luzhouman

我下载了运行了,还真是那么快.可否公布一下算法

收藏先!

庆祝本贴浏览量超过500
当然我自己也奉献了很多浏览量：）

收藏