排序，不过比较复杂，求助。(300分)

  • 主题发起人 主题发起人 kia2004
  • 开始时间 开始时间
如果你的实际数据也是５列，并且５列都是整数，并且内存足够大的话，＾＿＾，那么我给你的例子基本上就可以直接使用了，你只要把数据不断按照如下方式加载到内存中就可以了：
xs := xsl.NewXSort;
xs.V1:=1;
xs.V2:=3;
xs.V3:=5;
xs.V4:=7;
xs.V5:=7;
 
我只有晕的份
 
按照LeeChange兄的思路，编写了Compare函数，完整算法如下：
（注：为了保持灵活性，没有将比较函数硬编码，而是继续对包含索引信息Idx数组进行循环处理）
uses
Math;
var
Idx:array of Shortint;
Data:array of array [1..4] of Byte;
//4列——去掉了原来第一个序号列
function MyMultiCompare(Item1, Item2: Pointer): Integer;
var
i,d:Integer;
begin
Result:=0;
for i:=Low(Idx) to High(Idx)do
begin
d:=Idx;
if d>0 then
begin
Dec(d);
if d=0 then
Result:=Integer(Item1)-Integer(Item2)
else
Result:=Data[Integer(Item1)][d]-Data[Integer(Item2)][d];
end
else
if d<0 then
begin
d:=-d-1;
if d=0 then
Result:=Integer(Item2)-Integer(Item1)
else
Result:=Data[Integer(Item2)][d]-Data[Integer(Item1)][d];
end;
if Result<>0 then
exit;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
a:TList;
i,DataLen:Integer;
t:Integer;
mstr:String;
begin
SetLength(Idx,4);
Idx[0]:=-2;
Idx[1]:=3;
Idx[2]:=-4;
Idx[3]:=-1;
DataLen:=5;
SetLength(Data,DataLen);
if DataLen=5 then
begin
Data[0][1]:=3;
Data[0][2]:=5;
Data[0][3]:=7;
Data[0][4]:=7;
Data[1][1]:=12;
Data[1][2]:=5;
Data[1][3]:=0;
Data[1][4]:=2;
Data[2][1]:=3;
Data[2][2]:=5;
Data[2][3]:=7;
Data[2][4]:=7;
Data[3][1]:=0;
Data[3][2]:=2;
Data[3][3]:=2;
Data[3][4]:=8;
Data[4][1]:=12;
Data[4][2]:=7;
Data[4][3]:=0;
Data[4][4]:=8;
end
else
begin
RandSeed:=9876;
for i:=Low(Data) to High(Data)do
PInteger(@Data)^:=Random(MaxInt);
//一次性写入4Byte随机数据
end;
t:=GetTickCount;
a:=TList.Create;
a.Capacity:=DataLen;
for i:=0 to High(Data)do
//依次写入序号
a.Add(Pointer(i));
a.Sort(MyMultiCompare);
Caption:=Format('Time Cost: %.2f s',[(GetTickCount-t)*0.001]);
//完成排序后，在此做元素交换工作...
//输出前5组元素
mstr:='';
for i:=0 to Min(High(Data),5)do
begin
mstr:=mstr+Format('%d: [%2d %2d %2d %2d]'#13#10,
[Integer(a)+1,Data[Integer(a)][1],Data[Integer(a)][2],Data[Integer(a)][3],Data[Integer(a)][4]]);
end;
ShowMessage(mstr);
a.Free;
SetLength(Idx,0);
SetLength(Data,0);
end;

在我的本本（迅驰1.4G）上，DataLen为1000000时，排序耗时约2秒，为10000000时，耗
时约30秒。
 
高手太多了！！
 
//完成排序后，在此做元素交换工作...
不知道加上交换的时间会为多少
 
排序的时间复杂度为O(N*logN)，交换没有什么“技术含量”，时间复杂度为O(N)。而楼
主面临的N至少在百万级别以上，所以，加上交换后，总耗时不会有什么变化。[:)]
 
creation-zy写的Compare有一点不是能够很好理解,可能是我还没完全看懂的缘故吧,我的理解Compare的实现应该就只要根据传入的两个值(单列)简单比较出大小就可以了(我就是这么做的,好象TStringlist也是这么做的),但creation-zy和LeeChange大侠写的里面用了循环来处理(也就是那个IDX),是为了处理多列吗,原理是什么呢? 好象每次调用Compare都要循环IDX一次!
 
每次比较时都用循环是因为比较的对象超过了一个元素。在您的算法中，将V1-V5的叠加
直接展开到了方法内部，虽然不是显式的循环，但等于做了5遍，总体复杂度并没有下降。
design1兄指出了一个问题：二分法排序中进行循环比较实际上降低了效率——更糟糕的
是，每次比较都会遍历，所以实际的复杂度变成了O(N*LogN*5)。
如果非要针对本问题进行“精确优化”，我们可以利用数据范围小、且只有4个元素的特
点，将数组中的元素在排序前提前“归一化”——拼凑为可进行整体比较的LongWord（思路
与等长字符串拼接相同，只不过可以直接用一个CPU指令进行比较）。这样，花费在预处理
上的时间顶多为N*4，而在二分法比较时，可以将耗时由N*LogN*5下降到小于N*LogN*2的更
佳水平。
working...
 
恩，是的，的确我的算法从Ｖ１－Ｖ５我是用了递归来处理，先比第一列，比完后找出同值部分，在第二列继续比较（多个小范围的排序），如此类推下去直到最后一列，理论上从复杂度来说，的确是做了５遍，理论复杂度并没有下降，不过其中做了一点处理，因为在实际情况中，一列中经过一次排序后，找不到两个以上相同的值的会被过滤掉不做排序，这一点非常有帮助，因为经过一次排序后，一般来说大量的值是唯一的，有两种特殊情况，一是存在很特殊的不均匀的大范围同值数据，再经过一次排序，在第三次排序后同理变的非常小，因此这是一个下降的过程，所以实际上第二遍，第三遍．．．第Ｎ遍的时候，多个小范围相加的范围并非等同于第一遍的范围，而是急剧下降，第二种情况是刚好每一遍都是很平均的分布，比如刚好只有两个值或者三个值（比如　12 12 12 33 33 33 97 97 97.....），那么最后的复杂度极端情况下,是N*(LogN+LogN/2+LogN/4+...).所以总体上会比列数乘上快速排序的复杂度要要小,列数越多,效果越明显!
实际情况中,在复杂度相同的情况下,采用简单的循环比递归效率要高,还有我的实现从通用的角度去考虑了一些问题,如多种类型排序,所以在许多方面会增加开销!如果单从楼主的例子来看,因为全部是数值,正如creation-zy大侠的方法,有很多可以优化的地方,呵呵,creation-zy前后两种方法都使用了拼凑来处理这个问题,的确是另辟稀径,学习了
 
creation-zy大侠这么晚还在工作中啊，呵呵，注意休息呀，偶sleeping
 
uses
Math;
type
ItemDataType=Byte;
//数组元素类型——如果范围超过0..255，就应定义为Word、Cardinal或Integer
BigDataType=Integer;
//可以考虑使用Cardinal或Int64？
var
//控制变量
DataLen:Integer=1000000;
Pretreatment:Boolean=true;
//预处理——在排序之前将数据按照索引的要求排列好，以便简单比较
IndexCombine:Boolean=true;
//允许位于末端的序号索引加入到Data2的数据元素中去
//数据变量
Idx:array of Shortint;
Data:array of array [1..4] of ItemDataType;
//4列——去掉了原来第一个序号列
Data2:array of BigDataType;
//无符号数组，用于高速排序
IdxEndWithDataIndex:Boolean;
function MyMultiCompare(Item1, Item2: Pointer): Integer;
var
i,d:Integer;
begin
Result:=0;
for i:=Low(Idx) to High(Idx)do
begin
d:=Idx;
if d>0 then
begin
Dec(d);
if d=0 then
Result:=Integer(Item1)-Integer(Item2)
else
Result:=Data[Integer(Item1)][d]-Data[Integer(Item2)][d];
end
else
if d<0 then
begin
d:=-d-1;
if d=0 then
Result:=Integer(Item2)-Integer(Item1)
else
Result:=Data[Integer(Item2)][d]-Data[Integer(Item1)][d];
end;
if Result<>0 then
exit;
end;
end;

function SimpleCompare(Item1, Item2: Pointer): Integer;
var
i,d:Integer;
begin
Result:=Data2[Integer(Item1)]-Data2[Integer(Item2)];
//若BidDataType不是Integer，此处就不能这样简单的相减
if (Result<>0) or not IdxEndWithDataIndex then
exit;
Result:=Idx[High(Idx)]*(Integer(Item2)-Integer(Item1));
//最后一个索引应当是1或-1
end;

procedure TForm1.Button1Click(Sender: TObject);
var
a:TList;
i,j,d,BitCount,bc2,m:Integer;
n:Cardinal;
t:Integer;
mstr:String;
DataIsByte:Boolean;
begin
if DataLen<=1 then
exit;
SetLength(Idx,4);
Idx[0]:=-2;
Idx[1]:=3;
Idx[2]:=-4;
Idx[3]:=-1;
//对Idx进行检查——如果对序号的排序不在最后，且DataLen大于255，将无法使用Pretreatment机制
for i:=Low(Idx) to High(Idx)-1do
if ABS(Idx)=1 then
begin
if DataLen>MaxByte then
begin
MessageDlg('Sort by Index not on the tail, Pretreatment can''t work.', mtWarning, [mbOK], 0);
Pretreatment:=false;
break;
end;
end;
IdxEndWithDataIndex:=ABS(Idx[High(Idx)])=1;
//若索引长度不足BigDataType的，可将序号值的一部分“填补”到末端以提高一次比较就发现差别的几率
if Pretreatment and IndexCombine and IdxEndWithDataIndex
and (High(Idx)*SizeOf(ItemDataType)<SizeOf(BigDataType)) then
begin
//获取二进制的DataLen中最高位"1"所在位置(0..31)
BitCount:=SizeOf(DataLen)*8-1;
while DataLen shr BitCount=0do
Dec(BitCount);
if Idx[High(Idx)]<0 then
//如果序号以反序形式参加排序，则需要给出可能最大值用于相减运算
begin
if BitCount=31 then
m:=$7FFFFFFF
else
m:=(1 shl (BitCount+1))-1;
end
else
m:=0;
//根据剩余的字节数以及最高非零位的位置，计算拼接序号值时需要移位的位数
bc2:=(SizeOf(BigDataType)-SizeOf(ItemDataType)*High(Idx))*8-1;
//序号之前的数据需要“腾出”的位数（-1是避免最高的符号位被占用）
BitCount:=Max(BitCount+1-bc2,0);
end
else
begin
bc2:=0;
BitCount:=0;
m:=0;
end;

SetLength(Data,DataLen);
DataIsByte:=SizeOf(ItemDataType)=1;
if Pretreatment and not DataIsByte then
begin
MessageDlg('Pretreatment can''t work on data item bigger than Byte!', mtWarning, [mbOK], 0);
Pretreatment:=false;
end;
if DataLen=5 then
//针对5个元素的特殊处理——用固定的测试数据填充，便于检查算法正确性
begin
Data[0][1]:=3;
Data[0][2]:=5;
Data[0][3]:=7;
Data[0][4]:=7;
Data[1][1]:=12;
Data[1][2]:=5;
Data[1][3]:=0;
Data[1][4]:=2;
Data[2][1]:=3;
Data[2][2]:=5;
Data[2][3]:=7;
Data[2][4]:=7;
Data[3][1]:=0;
Data[3][2]:=2;
Data[3][3]:=2;
Data[3][4]:=8;
Data[4][1]:=12;
Data[4][2]:=7;
Data[4][3]:=0;
Data[4][4]:=8;
end
else
begin
RandSeed:=9876;
if DataIsByte then
//如果是Byte
begin
for i:=Low(Data) to High(Data)do
PInteger(@Data)^:=Random(MaxInt);
//一次性写入4Byte随机数据
end
else
begin
for i:=Low(Data) to High(Data)do
for j:=1 to 4do
Data[j]:=Random(MaxInt);
end;
end;
t:=GetTickCount;
if Pretreatment then
//预处理——将第二个维度处理为可简单比较的无符号整数
begin
SetLength(Data2,DataLen);
//不影响原二维数组，使用Data2存放处理后的数据
for i:=Low(Data) to High(Data)do
begin
n:=0;
for j:=Low(Idx) to High(Idx)do
begin
d:=Idx[j];
if d>0 then
begin
Dec(d);
if d>0 then
n:=(n shl 8)+Data[d]
else
if not IdxEndWithDataIndex then
n:=(n shl 8)+i;
end
else
if d<0 then
begin
d:=-d-1;
if d>0 then
n:=(n shl 8)+MaxByte-Data[d]
else
if not IdxEndWithDataIndex then
n:=(n shl 8)+MaxByte-i;
end;
end;
if bc2>0 then
//将数据向左移动，腾出位置，加入序号的一部分
begin
if m>0 then
begin
d:=m-i;
end
else
d:=i;
n:=(n shl bc2)+(d shr BitCount);
end;
Data2:=n;
end;
end;
a:=TList.Create;
a.Capacity:=DataLen;
for i:=0 to High(Data)do
//依次写入序号
a.Add(Pointer(i));
if Pretreatment then
a.Sort(SimpleCompare)
else
a.Sort(MyMultiCompare);
Caption:=Format('Time Cost: %.2f s',[(GetTickCount-t)*0.001]);
//完成排序后，在此做元素交换工作...
//输出前5组元素
mstr:='';
for i:=0 to Min(High(Data),5)do
begin
mstr:=mstr+Format('%d: [%2d %2d %2d %2d]'#13#10,
[Integer(a)+1,Data[Integer(a)][1],Data[Integer(a)][2],Data[Integer(a)][3],Data[Integer(a)][4]]);
end;
ShowMessage(mstr);
a.Free;
SetLength(Idx,0);
SetLength(Data,0);
if Pretreatment then
SetLength(Data2,0);
end;

新算法的测试结果： DataLen为1000000时，耗时约1.2秒；为10000000时，约16.9秒——提速近1倍:)
（测试时，变量Pretreatment为真，而IndexCombine对结果的影响看不出来）
 
to design1兄：
抱歉，刚才没有看清楚——使用递归不断缩小范围的策略是很好的:)
您提到了为了数据类型的通用性，有很多额外的开销——的确如此。不过，对于多维排序
算法而言，除了数据类型之外，还可能面临待排序维度多少的变化——如果在某个排序需求
中，待排序的字段不是5个，而是3个或10个，源代码似乎就面临非常大的改动——我有点不
解...
 
明白许多了，谢谢赐教。看来这个问题很是经典啊，看来楼主很是有福气啊。帮顶一下
 
你们都是夜猫子,俺比不了.
 
to creation-zy
呵呵，又提高了很多，刚开始看你那个拼凑的时候就觉得很有意思
第二个问题提的很好，可能这也是上面好几位朋友的疑惑吧，觉得我代码为什么写那么复杂，很多代码都和本例无关．．．．．．我上面提到我正在写一个简单的开源小框架，这个小框架是基于DesignOne（我写的另外一个工具）模板技术的，我上面的代码是通过我写的这个小框架自动生成，我这两天除了写了点测试代码外，没有写过一行代码，汗中．．．．．．(这么多行代码我哪一两天能写的完呀)，我定义了一张属性为５个整型属性的表（数据模型），然后把这张表映射到模板文件中，就直接生成上面我写的代码了，因此，＂待排序的字段不是5个，而是3个或10个＂，只要更改表结构（数据模型）就可以了，完全不用改一行代码．
呵呵，几位大侠的功底比我深厚多了，特别的，creation-zy的拼凑方法给让偶学到很多，我只不过是刚好看到这么一个需求，然后我写的模板代码正好有点关系，所以就拿过来实验一下，而你们是一会就唰唰唰写出来了，这是偶不能比的呀，偶现在正好在研究这些东西呢，有空可以到偶在csdn的博客(地址　http://blog.csdn.net/design1 )多指点指点，期待中．．．
　　
 
哈哈——果然是自动代码生成。高！[:D]
既然是自动生成的代码，是不是可以考虑生成非递归的版本以达到更高的效率。毕竟递归
这个模式本身就可以部分取代绝大多数的重复代码，而非递归的代码则往往因为重复代码过
多而难以编写及阅读。
多语言代码自动生成机制我也在研究，希望多多交流:)
 
过奖了,代码自动生成主要是简化重复劳动,本身没什么的
"既然是自动生成的代码，是不是可以考虑生成非递归的版本以达到更高的效率。毕竟递归
这个模式本身就可以部分取代绝大多数的重复代码，而非递归的代码则往往因为重复代码过
多而难以编写及阅读。"---这个完全可以,谈到这里,偶顺便就多谈一点,目前的很多开发存在一个问题就是很多东西再做重复劳动,比如楼主的例子,我相信已经有很多可用的方案了,但一般这些方法基本上一是都是基于特定的应用,二是都比较私人化,当下一个类似要求提出来的时候,对于不了解的人来说,可能又要仔细去研究一下,然后再写一次,如此反复
当时我就想如果这些已经讨论过并且很好的方案(比如creation-zy的拼凑法)能够有一个合适的机制让下一个类似的需求出现的时候,不用再去重复研究,那么将是一件非常好的事情,另外一个是数据本身就有很强的可重复性,这样一想,后来就慢慢逐渐找着点感觉,写了个解决类似问题的工具,就是我说的DesignOne
DesignOne目前已经做到和语言无关,也就是说支持多语言,或者说任何语言都支持,其中比较重要的思想就是模板技术,想法是能够把数据很好的穿透到技术中,而一组设计良好的模板基本上就是一个小小的框架性的东西,因此我又萌发了根据自己的经验,尝试着写一些可以用的框架模板出来,这样当下一次有类似需要的时候,我只要设计好数据模型,就直接可以用了,当然,如果别人也有类似的需求,并能够从中受益,那就更好不过了,所以我就开源了,我BLOG里的开源xDom正是基于这样的想法而来的!
以此类推,creation-zy和上面的几位大侠自己肯定也有很多很丰富的经验,如果有兴趣的话,能够把自己多年的技术经验形成框架性的东西,并且模板化,那么我想不仅自己能够受益,可能的话,也可以让很多人受益-------使用者只管设计数据模型,设计好后,大部分代码就可以产生了!当然,产生的代码是实用的,高效的,就比如creation-zy的拼凑法,可以说就是提供一个专家经验库,通过模板技术,并且这些库能够很快的用到实际中．
呵呵,扯远了，感觉有很多想法很接近呀
 
呵呵，看过creation-zy大侠的笔记后，发现在这方面已经做了非常之多的工作，偶上面最后的话冒失了，收回，哈哈．．．．
 
看到高手的代码真佩服，说说我的排序；
先把上述数据添加到sql数据库的 table1,第一列叫C1,依次C2,C3,C4,C5;
然后从数据库读出来：select * from table1 order by C2 desc,c3 desc,c4 desc,c5 desc,C1 desc;然后在query中要按行取列取都可以。为了不占用网络可以用本机Access数据库或Excel。
 
用数据库的排序机制来做是一个更加通用的方案——OK，让我们来试验：
procedure TForm1.Button1Click(Sender: TObject);
var
i,j,DataCount:Integer;
t:Integer;
Data:array of array[1..4] of Byte;
begin
DataCount:=SpinEdit1.Value;
SetLength(Data,DataCount);
RandSeed:=9876;
for i:=Low(Data) to High(Data)do
PInteger(@Data)^:=Random(MaxInt);
//一次性写入4Byte随机数据
with ADOQuery1do
begin
//使用SQL Server的临时表以尽可能的避免产生不必要的磁盘IO
SQL.Text:='CREATE TABLE #TB1 ('
+' [I0] [int] NOT NULL ,'
+' [I1] [tinyint] NOT NULL ,'
+' [I2] [tinyint] NOT NULL ,'
+' [I3] [tinyint] NOT NULL ,'
+' [I4] [tinyint] NOT NULL'
+')';
ExecSQL;
end;
t:=GetTickCount;
with ADOTable1do
begin
Open;
Edit;
for i:=Low(Data) to High(Data)do
begin
AppendRecord([i+1,Data[1],Data[2],Data[3],Data[4]]);
end;
try
Post;
except
end;
end;
Caption:=Format('DataCount: %6d Insert: %.2f s',[DataCount,(GetTickCount-t)*0.001]);
t:=GetTickCount;
with ADOQuery1do
begin
SQL.Text:='Select I0 From #TB1 Order By I1 desc, I2, I3 desc, I0 desc';
Open;
Last;
//移动记录指针到末端（确定所有的数据都已提取）
Close;
end;
Caption:=Caption+Format(' Order By: %.2f s',[(GetTickCount-t)*0.001]);
SetLength(Data,0);
with ADOQuery1do
begin
SQL.Text:='DROP TABLE #TB1';
ExecSQL;
end;
end;

下面是测试结果（测试环境与我之前的算法测试环境相同）：
数据量 Insert(秒) Order By(秒)
10000 4.24 0.06
20000 8.45 0.13
50000 21.87 0.35
100000 42.50 0.81
可以看出，SQL Server的耗时基本上呈线性增长，即便忽略Insert的时间（考虑到读取2G
文本本身就会花费大量的时间，而在此期间操作系统会自动利用磁头的寻道间隙执行内存操
作，所以这个时间可以被忽略），在数据量为100000时耗时已达0.8秒。而内存算法在行数
为100000时的测试结果为0.05秒（因为数据量太小，数组成员的访问都位于CPU的Cache内，
效率极高），即便扩大到1000000行乃至更大的情况，内存算法也快于数据库数倍（从已知
测试结果进行推理——在最理想的情况下，SQL Server对1000000行进行排序操作也要8秒，
二者排序耗时比约为1.2比8——即超过6倍）。
不过，话说回来——虽然数据库排序效率上没有优化后的内存算法快，但考虑到SQL语句
本身极大的灵活性（别忘了——Order By中可以包含复杂表达式！），确实是一个选择（可
以不用挖空心思想算法，少死很多脑细胞:D 但也只能在数据量不大的情况使用，否则光填
充数据就有的等啦:P）。
 
您必须登录或注册才可回复。

Similar threads

万
关于内存数据与 JSON - 万一
回复
0
查看
676
万一
万
不
ISO8583报文协议（转） - 不得闲
回复
0
查看
848
不得闲
不
S
[杂谈]Rad Studio 2018年2月份热修复的变动说明（含 2004 修正）
回复
0
查看
603
swish
S
D
[原]OrangeUI之ListView的简单介绍
回复
0
查看
2K
DelphiTeacher的专栏
D
D
[原]OrangeUI之ListView的简单介绍
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部