来来来,看看你的水平有多高!——Aimingoo送分项目(超过600大元) (0分)

  • 主题发起人 aimingoo
  • 开始时间
B

Brave

Unregistered / Unconfirmed
GUEST, unregistred user!
467个字符,form以圆形的形式,从中间向四周扩散,受字符限制,只能实现该简单功能。
借以抛砖引玉,让大家对form边界有好的认识。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
r:thandle;
i:integer;
begin
for i:=1 to trunc(width/1.414) do
begin
r:=CreateEllipticRgn(trunc(width/2)-i,trunc(height/2)-i,trunc(width/2)+i,trunc(height/2)+i);
SetWindowRgn(handle,r,true);
sleep(10);
end;
end;

end.
 
N

netup

Unregistered / Unconfirmed
GUEST, unregistred user!
不管我的建议是否被采用, 我还是觉得应将一变量, 常量, 对象, 类等长度视为一个字
节, 如我为了512而将code统统有a, b, c, d , e, f......z, a1, b1.....z1去表示的话
我也能在512内完成, 但我想这不是我们交流的目的, 所以分数只能放一边, 思想是第一位
的.
这是一个很实用的程序, 大家可以继续完善, 如加入删除进度条, 但计算时间我不知
道如何实现. 如大家有好的改进, 烦请贴出来让大家共享, 并请email一分给我, 我也想学
习学习大家的心得呀(netup@163.com);
注: 同样的原理,你可实现文件的复制, 移动, 设置或取消文件的属性等功能, 请初学
者不要盲目试用, 不小它会kill all data in your harddisk!!!!

//項目
program delfile;
uses
Forms,
maindeletefile in 'maindeletefile.pas' {frmDelfile},
delfileex in 'delfileex.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TfrmDelfile, frmDelfile);
Application.Run;
end.

===============================================================================
//主Form
unit maindeletefile;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, FileCtrl;
type
TfrmDelfile = class(TForm)
Button1: TButton;
deldir: TDirectoryListBox;
DriveComboBox1: TDriveComboBox;
delMark: TEdit;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmDelfile: TfrmDelfile;
implementation
uses delfileex;
{$R *.DFM}

procedure TfrmDelfile.Button1Click(Sender: TObject);
var
delfilename: String;
begin
delfilename := deldir.Directory+'/' + delMark.Text;
DeleteFileEx(delfilename);
ShowMessage('delete ok');
end;

end.
================================================================================
//功能unit;
unit delfileex;
interface
uses
windows, Sysutils;
function CompStr(str, pattern: String): Boolean;
function DeleteFileEx(FileName: String): Boolean;
implementation
function CompStr(str, pattern: String): Boolean;
var
pstr: array [0..255] of Char;
pPattern: array [0..255] of Char;
function CompPattern(element, pattern: PChar): Boolean;
begin
if 0 = StrComp(pattern,'*') then
Result := True
else
if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else
if element^ = Chr(0) then
Result := True
else
begin
case pattern^ of
'*': if CompPattern(element,@pattern[1]) then
Result := True
else
Result := CompPattern(@element[1],pattern);
'?': Result := CompPattern(@element[1],@pattern[1]);
else
if UpCase(element^) = Upcase(pattern^) then
Result := CompPattern(@element[1],@pattern[1])
else
Result := False;
end;
end;
end;

begin
StrPCopy(pstr,str);
StrPCopy(pPattern,pattern);
Result := CompPattern(pstr,pPattern);
end;

function DeleteFileEx(FileName: String): Boolean;
var
SearchData: TWin32FindData;
FindHandle: THandle;
AllMark, DelMark, FilePath, FindFileName: String;
begin
FilePath := ExtractFilePath(FileName);
DelMark := ExtractFileName(FileName);
AllMark := '*.*';
FindHandle := FindFirstFile(pchar(FilePath+AllMark), SearchData);
if FindHandle <> INVALID_HANDLE_VALUE then
repeat
FindFileName := SearchData.cFileName;
if boolean(SearchData.dwFileAttributes and FILE_ATTRIBUTE_READONLY) then
SetFileAttributes(pchar(FilePath + FindFileName), SearchData.dwFileAttributes - FILE_ATTRIBUTE_READONLY);
if (FindFileName <> '.') and (FindFileName <> '..') then
begin
if boolean(SearchData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) then
begin
DeleteFileEx(FilePath + FindFileName + '/' + DelMark);
if DelMark = AllMark then
RemoveDir(FilePath + FindFileName);
end
else
if CompStr(FindFileName, DelMark) then
DeleteFile(FilePath + FindFileName);
end;
until FindNextFile(FindHandle, SearchData) = false;
end;
end.
===============================================================================
 
C

creation-zy

Unregistered / Unconfirmed
GUEST, unregistred user!
to aizb:
呵呵,请您用一下我的程序,压缩效率好像要高一点哟[:)](您的源代码经过我的计算,长度为1595)
像 While ((j<Length(f)) and (f[j]=' ')) do
Inc(j);
这样的语句,可以简化成 While((j<Length(f))and(f[j]=' '))do Inc(j);
如果程序更加智能化,可以简化为: While(j<Length(f))and(f[j]=' ')do Inc(j);
(这个我还做不到)
您的WideString技巧值得学习!
共同进步![:)]
 
L

l_x_yuan

Unregistered / Unconfirmed
GUEST, unregistred user!
我这里有一个小程序是写login file。先在C:/Program Files/Borland/Delphi6/Demos/Db/TextData
安装textpkg.dpk 。下面是代码:
unit Unt;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, TextData;
const
F = 'Login.Txt';
type
TFrm = class(TForm)
Text: TTextDataSet;
procedure FormShow(Sender: TObject);
private
public
end;

var
Frm: TFrm;
implementation
{$R *.dfm}
procedure TFrm.FormShow(Sender: TObject);
var
Handle: integer;
begin
if not FileExists(F) then
begin
Handle := FileCreate(F);
FileClose(Handle);
end;
Text.FileName := F;
Text.Active := true;
Text.Append;
Text.Fields[0].value := DateTimeToStr(now) + ' Logined';
Text.Post;
Text.Close;
end;
end.
不多不少正好是512个字符。可以用下面程序测试
function TFrmMain.moveNoVisibleChar(strMessage: string): string;
var
i, j: integer;
resultStr: string;
begin
j := Length(strMessage);
for i := 1 to j do
begin
if trim(strMessage) <> '' then
resultStr := resultStr + strMessage;
end;
result := resultStr;
end;
放上一个memo控件,label控件在memo的onchang事件里写下
Label1.Caption := '合计' + inttostr(Length(moveNoVisibleChar(EdtBody.text))) + '字符';
 
O

Oldtiger

Unregistered / Unconfirmed
GUEST, unregistred user!
这个题目已经半个月了,还是有不少高手在继续努力
我在此谈点看法,不知对否:
1、限制字数还是有必要的,尽管我们已经不是机器玛时代了,但一个程序的效率
是足以反映一个程序员的编程水准的,在程序员中推广严谨的编程风格,对于提高
整个民族的编程水平有益无害;
2、字数限制为512或2K其实不能反映一个程序的真实效率,我建议改为[red]有效语句句数,
并加上加权分[/red]。例如,[blue]以一个赋值语句为1分,一个条件语句为4分,一个循环语句为7分,
一个标准函数调用3分,一个非标准函数调用8分,最后每个语句乘以加权分的总和为
该程序的得分[/blue]。[gold]以得分少者为王[/gold],这样可能就可以避免像楼上各位谈到的变量名
缩玛和变量、常量、类型等声明占用字数的问题了;
3、我在第2点提到的加权分大致是以语句编译成机器玛之后占用的空间比例来定的,如果
高手们觉得这样的比例还不太合适,还可以继续商讨;
[:)][:)][:)][:)][:)][:)][:)]

 
D

darkiss

Unregistered / Unconfirmed
GUEST, unregistred user!
{**********************************************************************
SaftPtr
Automatically allocate memories and free them
Author :Darkiss
Create Date :2001/10/17
**********************************************************************}
unit SafePtr;
interface
uses
classes, SysUtils ;
type
TObjRecord = class
private
FClass :TClass ;
FObject :TObject ;
public
constructor Create(SomeClass:TClass) ;
destructor Destroy ;override ;
published
property ptrClass :TClass read FClass ;
property ptrObject:TObject read FObject;
end ;
TSafePtr = class
private
FList:TList ;
public
constructor Create ;
overload ;
destructor Destroy ;override ;
function Create(SomeClass:TClass):TObject ;
overload ;
end ;

implementation
{ TObjRecord }
constructor TObjRecord.Create(SomeClass:TClass);
begin
if not Assigned(SomeClass) then
raise Exception.Create('TObjRecord.Create: Invalid Class!') ;
FClass := SomeClass ;
try
FObject := FClass.Create ;
except
on Exception do
raise Exception.Create('TObjRecord.Create: Can not Create Object!');
end ;
end;

destructor TObjRecord.Destroy;
begin
if Assigned(FObject) then
with FObject as FClass do
free ;
inherited;
end;

{ TSafePtr }
constructor TSafePtr.Create ;
begin
FList := FList.Create ;
end;

function TSafePtr.Create(SomeClass: TClass): TObject;
var temp :TObjRecord ;
begin
try
temp := TObjRecord.Create(SomeClass) ;
except
raise Exception.Create('TSaftPtr.Create: Error Create Ptr') ;
exit ;
end ;
FList.Add(temp) ;
end;

destructor TSafePtr.Destroy;
var temp :TObjRecord ;
begin
while Boolean(FList.Count) do
begin
temp := FList.Last ;
with temp.FObject as temp.FClass do
free ;
FList.Delete(FList.Count-1) ;
end ;
FList.Clear ;
inherited;
end;

end.
 

狐狸精

Unregistered / Unconfirmed
GUEST, unregistred user!
Z

zwma

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;
//修改屏幕的分辨率
interface
uses
Forms, Windows;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
j:integer;whd:Thandle;
dm:_Devicemodea;
begin
whd:=findwindow('Shell_traywnd',nil);
j:=0;
while dm.dmpelswidth<>800 do
//修改屏幕的分辨率为800
begin
EnumDisplaySettings(nil,j,dm);
j:=j+1;
end;
dm.dmfields:=dm_pelswidth OR dm_pelsheight;
ChangeDisplaySettings(dm,1);
showwindow(whd,SW_SHOW);
end;
end.
 
G

gcq

Unregistered / Unconfirmed
GUEST, unregistred user!
楼上的,你理解错题意了吧!:)
 

大唐双龙

Unregistered / Unconfirmed
GUEST, unregistred user!
A

aimingoo

Unregistered / Unconfirmed
GUEST, unregistred user!
好了,我来给一段代码吧。哈哈~~~~~~~~
最近在写ISAPI Filter,为了实现好的性能,我想要以尽可能快的速度操
作TList。到底要以什么速度呢?哈哈,大家看看下面的代码就明白了。
:)
1. 问题提出:如何更快速地从TList中删除部分连续的Item。
有这样的一段代码:
var p : pChar = 'abcdefgh';
procedure TestDelFromTList;
var t1 : TList;
i : integer;
maxI : integer;
begin
t1 := tlist.create;
t1.count := 100000;
for i:=0 to t1.count-1 do
t1 := p;
maxI := t1.count-10-1;
//最后一个结点
for i:= maxI do
wnto 10 do
t1.delete(i);
//for i:=10 to t2.count-10-1 do
t2.delete(10);
end;
这段代码是初始化一个100000个结点的List,然后删除其中的第10个到倒数第10个。这段
代码是逆向的,这样的删除速度比较快。如果换成正向删除(已经注释掉),则速度就慢得
非常多了。
这样的删除是正常的算法。我用测效率的程序测试过,逆向删除算法的耗时是21.66个毫秒,
则正向删除的耗时却能达到58099.02个毫秒。速度慢了2680倍!!!
但这样就很快了么?不是!我认为就算是逆向删除的速度也并不是快的。
分析TList这个类的源码,我们可以看到,它是这样写的(我加入了注释):
procedure TList.Delete(Index: Integer);
var
Temp: Pointer;
begin
if (Index < 0) or (Index >= FCount) then
Error(@SListIndexError, Index);
//判定Index值是否超界
Temp := Items[Index];
//取待删除结点
Dec(FCount);
//Count减一
if Index < FCount then
System.Move(FList^[Index + 1], FList^[Index],(FCount - Index) * SizeOf(Pointer));
//将待删除结点后的Buffer提前
if Temp <> nil then
Notify(Temp, lnDeleted);
//发通告
end;
由于在TList类是将全部的结点指针存放在FList这个动态数组的指针中,所以只需
要将Index+1之后的内存块向前移4个字节,即SizeOf(Pointer),即可实现Index结
点的删除。
但是,如果使用这样来删除成批连续的(N个)结点,则要实现N次system.move()操作,
操作的内存块的大小决定了system.move()操作的耗时,而Index值越小的的结点在FList
中越靠前,则system.move()要操作的内存块也就越大。这就是我认为上述成批删除效
率不高的原因,也是正向删除比逆向删除的耗时慢了慢了2680倍的原因。
对于成批删除,理想的算法是从index+len结点开始位置,向前移动count-index-len个
结点,这样,就能够一次完成全部的结点移动,实现删除操作。
这个思路非常好,至少我认为是这样。为此,我实现了下面的代码:
procedure CutList(aList:TList;
left,len:integer);
begin
with aList do
begin
System.Move(List^[left+len], List^
, (Count-left-len) * SizeOf(Pointer));
count := count-len;
end;
end;
这段代码的功能是在TList.List这个Buffer中,将删除后的剩余结点直接移动到Left
这个位置上,从而完成全部的移动操作。
然后,我们再设count := count-len;来使用个数减少,从而完成了成批量的删除。
好的,如果一切正常,算法的速度将大幅度提升!OHHH,美妙的想法!
但是,真的是这样么?我再用效率测试程序来测试了一轮,结果是这样的:
测试数据为10万个结点,则逆向删除算法耗时为20.56毫秒,CutList()函数耗时9.69毫秒;
测试数据为100万个结点,则逆向删除算法耗时为209.13毫秒,CutList()函数耗时98.01毫秒。
速度比逆向算法提高了一倍,而且应该注意到,CutList()的耗时仍然随数据量的增大而等比
例的增大!!!而事实上,从CutList()函数的实现来看,数据量增大,算法耗时应该只增加
极少才对。
为什么呢???要知道,只加快一倍速度的CutList(),并不是我所想要的!!!
再次分析TList类的实现代码,发现count接口实现时,是用setCount来写值,即CutList()函
数中,
count := count-len;
一行的调用,实际上将调用TList.setCount(count-len);
而TList.setCount()的实现代码如下:
procedure TList.SetCount(NewCount: Integer);
var
I: Integer;
begin
if (NewCount < 0) or (NewCount > MaxListSize) then
Error(@SListCountError, NewCount);
if NewCount > FCapacity then
SetCapacity(NewCount);
if NewCount > FCount //如果要增加Count的值,则调用Fillchar()来填充FList这个Buffer
//如果是要减少Count的值,则用for循环调用Delete()来删除结点
then
FillChar(FList^[FCount], (NewCount - FCount) * SizeOf(Pointer), 0)
else
for I := FCount - 1 do
wnto NewCount do
Delete(I);
FCount := NewCount;
end;

请注意看我在上面注释!OH!事实上,setCount这个操作仍然将调用Delete()来删除各个结点
(注意,Borland为了提高这个删除速度,也使用了逆向删除的算法来实现对Delete()的调用)。
所以,我们并不能在CutList()中得到更好的算法效率!——尽管,我们已经只要,只需要将count
设成指定值即可,而并不需要再来一次成批的Delete()!
Count属性是可读写的,它的定义是这样的:
TList = class(TObject)
private
FList: PPointerList;
FCount: Integer;
...
protected
...
procedure SetCount(NewCount: Integer);
...
public
...
property Count: Integer read FCount write SetCount;
...
property List: PPointerList read FList;
end;
我们看到,Count读是直接读FCount的值,而写操作是调用SetCount()函数。那么,我们想一想,
既然“Count读是直接读FCount的值”,那么,Count的地址是不是也直接指向FCount呢???
下面的测试代码可以证明这一点:
program testFixCount;
uses classes, Dialogs, sysUtils;
var t : TList;
pCount : ^Integer;
begin
t := TList.create;
t.Count := 10000;
pCount := @t.Count;
pCount^ := 10;
showMessage(t.Count);
end.

我们看到,我们已经成功地修改了FCount的值,而没有通过TList.setCount()。^-^
——事实上,我们已经突破了Delphi在“类”封装时对FCount的保护,我们能够直接访
问Delphi的类中的私有属性了!!!:)
接下来,我们可以将curList()函数修改一下下了:
procedure CutList(aList:TList;
left,len:integer);
var pCount : ^Integer;
begin
with aList do
begin
System.Move(List^[left+len], List^
, (Count-left-len) * SizeOf(Pointer));
//count := count-len;
pCount := @Count;
pCount^ := count-len;
end;
end;

OK! 我再次用那个可爱的效率测试工具测试了一下下,结果,哈哈,漂亮!——
测试数据为10万个结点,则逆向删除算法耗时仍为20.56毫秒,准确地说是20333.25个微秒,而
新CutList()函数耗时仅为1.08个微秒;
测试数据为100万个结点,则逆向删除算法耗时为212.67毫秒(212668.22微秒),而这种情况下,
CutList()函数耗时仅为1.26个微秒,比10万个结点略略多了一点儿!:)
快了NNNNNNN倍!!!
哈哈,这就是我要的结果!一个不会随数据量增加而变慢的cutList()!
将全部测试代码写到下面:
program cutListFun;
uses windows, classes;
procedure CutList(aList:TList;
left,len:integer);
var pCount : ^Integer;
begin
with aList do
begin
System.Move(List^[left+len], List^
, (Count-left-len) * SizeOf(Pointer));
pCount := @Count;
pCount^ := count-len;
end;
end;

var
t1,t2 : TList;
p : pChar = 'abc';
oldTick : DWORD;
i,maxI : integer;
begin
t1 := TList.create;
t2 := TList.create;
t1.count := 1000000;
t2.count := 1000000;
for i:=0 to t1.count-1 do
t1 := p;
maxI := t1.count-10-1;
oldTick := GetTickCount;
for i:= maxI do
wnto 10 do
t1.delete(i);
writeln('need:', GetTickCount-oldTick, 'ms');
oldTick := GetTickCount;
CutList(t2,10, t2.count-20);
writeln('need:', GetTickCount-oldTick, 'ms');
end.

没有经过仍何优化,这段代码仅787个字节。^-^,如果按“有效字节数”来数,相信
可以低于512字节。
[red]其它:[/red]
---------------
1. 这段代码主要实现cutList()函数,用于极快速地从TList中删除一批连续结点。
2. 函数主要技巧是通过TList.list属性操作FList,使用system.move()快速移除结点。
3. 函数最重要的是使用@TList.Count有效地突破Delphi的类封装,直接访问和写私有域FCount。
4. 函数提供的突破类方法的思路可以进一步地扩展,可以通过突破一个私有域来访问该类所有的
域。示例代码如下:
program myTest;
{$APPTYPE CONSOLE}
uses classes, Dialogs, sysUtils;
var
t : TList;
pPrivateStrart : pointer;
pCount,pCapacity : ^Integer;
begin
t := TList.create;
t.Count := 10000;
pPrivateStrart := pointer(@t.List);
pCount := pointer(integer(pPrivateStrart) + sizeof(pointer));
pCapacity := pointer(integer(pCount) + sizeof(integer));
pCount^ := 10;
pCapacity^ := 1000;
writeln('FCount:',t.Count);
writeln('FCapacity:',t.Capacity);
end.

[red]分析:[/red]首先,TList的类定义如下,
TList = class(TObject)
private
FList: PPointerList;
FCount: Integer;
FCapacity: Integer;
protected
...
end;
这样,通过取TList.List就取得到FList的地址,同时,也就取得了整个private区的起始
地址,然后,通过指针运算,可以找到FCount和FCapacity的地址。——这得益于Delphi总
是用一个连续内存块来存储一个结构!
5. 由于直接访问私有域的方法超越了Delphi的对象保护,所以,访问私有域可能导致一些
负面影响。比如,直接修改FCount的方法并不会使FList占用的Buffer的空间增大或者减
小,也不会使Capacity的值发生任何变化。而在Delphi对于TList的类封装中,这三者之
间是有联系的。我们必须再加一些代码来维护这种关系,以保证TList类操作的正常。因
此,我们有必要进一步地修改cutList()函数。完整版本的cutList()函数如下(加注释):
//////////////////////
//需要维护Count与Capacity的关系,请在“pCount^ := count-len;”一行后加入如下代码:
// Capacity := Count;
//上一行代码在本函数的实现中被取消的原因如下:
//由于在TList中,Capacity决定了FList这个Buffer的大小,但在TList的算法实现上,并
//不在Delete()时减小Buffer的大小,多余出来的空间将留给以后的Add()使用,这样可以
//避免频繁的ReallocMem()调用导致效率下降。
//基于上述原因,我们不必要在这里用重设Capacity的方法来实际删除List^所占用的空间。
//但如果用户需要释放cut掉的空间,本行代码是可用的。
//另外,对于其它类中直接访问私有属性的情况,请考虑相关属性的重设。
//////////////////////
procedure CutList(aList:TList;
left,len:integer);
var pCount : ^Integer;
begin
with aList do
begin
System.Move(List^[left+len], List^
, (Count-left-len) * SizeOf(Pointer));
pCount := @Count;
pCount^ := count-len;
end;
end;

6. 程序功能的实现重要的在于思想,而代码字节数是次要的。​
 
Y

yyanghhong

Unregistered / Unconfirmed
GUEST, unregistred user!
好,程序员应该有这种精神,精益求精
 
A

aimingoo

Unregistered / Unconfirmed
GUEST, unregistred user!
哈哈,随便再给大家一个测试程序,和上面的思想是完全一样的。另外,curList()也
重写了一份,好象看起来代码也更精炼了。:)
[red]1. 测试一下下直接修改FCount[/red]
-------------------------------------
program TestFixCount;
{$APPTYPE CONSOLE}
uses SysUtils, classes;
begin
with TList.Create do
begin
count := 10000;
dec(integer((@Count)^), 100);
writeln(count);
free;
end;
end.

[red]2. 新版本的cutList()[/red]
-------------------------------------
procedure CutList(aList:TList;
left,len:integer);
begin
with aList do
begin
System.Move(List^[left+len], List^
, (Count-left-len) * SizeOf(Pointer));
dec(integer((@Count)^), len);
end;
end;
 

昊海

Unregistered / Unconfirmed
GUEST, unregistred user!
所有被尊称的高手都是相对的,相对于所处的领域的,这个世界永远也不会出现绝对的高手,
还是多谈谈开发规范、心得和协作吧。
 
C

creation-zy

Unregistered / Unconfirmed
GUEST, unregistred user!
to aimingoo:
呵呵,到底是主席,果然精彩![:)]
看了您的代码,我有了一个想法:Delphi的Delete过程之所以慢,主要是因为它在每次删除元素之后
都进行了Pack——即整体移位,由此导致了大规模删除的时候不可避免的低效率。在您的方法
中,巧妙的利用了操作的特殊性,自己进行整体移位(一次性的),达到了极高的效率。我认为,
出了您的这种方法,还有另一种方案,适用范围更加广泛,并且效率也很高,思路如下:
TList的Delete过程就像Memo.Lines的删除过程一样,如果不加处理,每执行一次就会导致一次重绘
(Pack),大规模删除时效率极低,但是,我们注意到,对于Memo.Lines(即TStrings),有
begin
Update和EndUpdate方法,用于控制重绘,如果在大规模操作之前加上一个begin
Update,操作完毕
之后再EndUpdate,效率就有极大的区别。我们可以构造一个TListEx类,实现对应的功能——当使用
begin
Update之后,Delete操作并不立即生效,而是简单的将Item标记为“已删除”(比如赋以Nil),
(注意到此时Delete的Index仍然是元素个数没有变化时的绝对位置,和正常情况下的Delete使用方法
不一样,为了避免混淆,可以改成SoftDelete [:)],这样begin
Update也可以省了),并且不改变Count
的值(因为两次执行SoftDelete(1)的结果与一次的一样!)。当用户认为大规模删除已经结束后,就
调用EndUpdate方法,进行一次性Pack!
EndUpdate过程的大致算法流程如下:
var
OldCount,i:Integer;
begin
OldCount:=FCount;
//原始大小
FCount:=0;
//计数器清零
for i:=0 to OldCount-1 do
begin
if List<>nil then
//未被删除
begin
List[FCount]:=List;
Inc(FCount);
//计数器+1
end;
end;
end;
上面算法实现了对多次SoftDelete之后的一次性Pack操作,而与被删除区域是否连续无关。[:)]
容易看出,SoftDelete的时间复杂度为O(1),EndUpdate的时间复杂度为O(Count)。而aimingoo的
改进方案为O(LeftCount)——与被移动的Item个数成正比,效率明显比我的方法要高,但是,它仅
适用于被删除的是连续区域的特殊情况。
与普通的Delete(仅删除一个元素)相比,三种方法的时间效率分别为:
CutList SoftDelete Delete
O(LeftCount) O(Count) O(LeftCount)
看来俺的方案的成绩不够理想嘛 :p 再改进!
——注意到部分在排头的元素在最终Pack的时候并不会被移动,我们可以用一个变量记录被删除的元素
的最小标号——FMinDelete,正常情况下,FMinDelete=FCount,在SoftDelete的时候,将被删除的Index
和它进行比较: if FMinDelete>Index then
FMinDelete:=Index;
然后,将EndUpDate改为:
begin
OldCount:=FCount;
//原始大小
FCount:=FMinDelete;
//
for i:=FMinDelete to OldCount-1 do
begin
...
end;
FMinDelete:=FCount;
//
end;
好了,我增加了SoftDelete的复杂度,达到了在仅删除一个元素的时候和Delete相近的速度。
在进行一次性连续删除的时候,SoftDelete比CutList至少慢2倍,但还没有数量级的差距,而CutList
就比Delete快了好几个数量级。在进行多次删除(与是否连续无关)的时候,SoftDelete应该比CutList、
Delete快好几个数量级(它们的差距应该和一次性连续删除时CutList和Delete的差距一样明显)。
[:)]
 

Similar threads

S
回复
0
查看
913
SUNSTONE的Delphi笔记
S
S
回复
0
查看
743
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
990
DelphiTeacher的专栏
D
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
顶部