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

design1 · 2008-09-13

如果你的实际数据也是５列，并且５列都是整数，并且内存足够大的话，＾＿＾，那么我给你的例子基本上就可以直接使用了，你只要把数据不断按照如下方式加载到内存中就可以了：
xs := xsl.NewXSort;
xs.V1:=1;
xs.V2:=3;
xs.V3:=5;
xs.V4:=7;
xs.V5:=7;

guth · 2008-09-13

我只有晕的份

creation-zy · 2008-09-13

按照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秒。

孙伟 · 2008-09-13

高手太多了！！

design1 · 2008-09-13

//完成排序后，在此做元素交换工作...
不知道加上交换的时间会为多少

creation-zy · 2008-09-13

排序的时间复杂度为O(N*logN)，交换没有什么“技术含量”，时间复杂度为O(N)。而楼
主面临的N至少在百万级别以上，所以，加上交换后，总耗时不会有什么变化。[

]

design1 · 2008-09-14

creation-zy写的Compare有一点不是能够很好理解,可能是我还没完全看懂的缘故吧,我的理解Compare的实现应该就只要根据传入的两个值(单列)简单比较出大小就可以了(我就是这么做的,好象TStringlist也是这么做的),但creation-zy和LeeChange大侠写的里面用了循环来处理(也就是那个IDX),是为了处理多列吗,原理是什么呢? 好象每次调用Compare都要循环IDX一次!

creation-zy · 2008-09-14

每次比较时都用循环是因为比较的对象超过了一个元素。在您的算法中，将V1-V5的叠加
直接展开到了方法内部，虽然不是显式的循环，但等于做了5遍，总体复杂度并没有下降。
design1兄指出了一个问题：二分法排序中进行循环比较实际上降低了效率——更糟糕的
是，每次比较都会遍历，所以实际的复杂度变成了O(N*LogN*5)。
如果非要针对本问题进行“精确优化”，我们可以利用数据范围小、且只有4个元素的特
点，将数组中的元素在排序前提前“归一化”——拼凑为可进行整体比较的LongWord（思路
与等长字符串拼接相同，只不过可以直接用一个CPU指令进行比较）。这样，花费在预处理
上的时间顶多为N*4，而在二分法比较时，可以将耗时由N*LogN*5下降到小于N*LogN*2的更
佳水平。
working...

design1 · 2008-09-14

恩，是的，的确我的算法从Ｖ１－Ｖ５我是用了递归来处理，先比第一列，比完后找出同值部分，在第二列继续比较（多个小范围的排序），如此类推下去直到最后一列，理论上从复杂度来说，的确是做了５遍，理论复杂度并没有下降，不过其中做了一点处理，因为在实际情况中，一列中经过一次排序后，找不到两个以上相同的值的会被过滤掉不做排序，这一点非常有帮助，因为经过一次排序后，一般来说大量的值是唯一的，有两种特殊情况，一是存在很特殊的不均匀的大范围同值数据，再经过一次排序，在第三次排序后同理变的非常小，因此这是一个下降的过程，所以实际上第二遍，第三遍．．．第Ｎ遍的时候，多个小范围相加的范围并非等同于第一遍的范围，而是急剧下降，第二种情况是刚好每一遍都是很平均的分布，比如刚好只有两个值或者三个值（比如　12 12 12 33 33 33 97 97 97.....），那么最后的复杂度极端情况下,是N*(LogN+LogN/2+LogN/4+...).所以总体上会比列数乘上快速排序的复杂度要要小,列数越多,效果越明显!
实际情况中,在复杂度相同的情况下,采用简单的循环比递归效率要高,还有我的实现从通用的角度去考虑了一些问题,如多种类型排序,所以在许多方面会增加开销!如果单从楼主的例子来看,因为全部是数值,正如creation-zy大侠的方法,有很多可以优化的地方,呵呵,creation-zy前后两种方法都使用了拼凑来处理这个问题,的确是另辟稀径,学习了

design1 · 2008-09-14

creation-zy大侠这么晚还在工作中啊，呵呵，注意休息呀，偶sleeping

creation-zy · 2008-09-14

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对结果的影响看不出来）

creation-zy · 2008-09-14

to design1兄：
抱歉，刚才没有看清楚——使用递归不断缩小范围的策略是很好的

您提到了为了数据类型的通用性，有很多额外的开销——的确如此。不过，对于多维排序
算法而言，除了数据类型之外，还可能面临待排序维度多少的变化——如果在某个排序需求
中，待排序的字段不是5个，而是3个或10个，源代码似乎就面临非常大的改动——我有点不
解...

xingxin00 · 2008-09-14

明白许多了，谢谢赐教。看来这个问题很是经典啊，看来楼主很是有福气啊。帮顶一下

LeeChange · 2008-09-14

你们都是夜猫子,俺比不了.

design1 · 2008-09-14

to creation-zy
呵呵，又提高了很多，刚开始看你那个拼凑的时候就觉得很有意思
第二个问题提的很好，可能这也是上面好几位朋友的疑惑吧，觉得我代码为什么写那么复杂，很多代码都和本例无关．．．．．．我上面提到我正在写一个简单的开源小框架，这个小框架是基于DesignOne（我写的另外一个工具）模板技术的，我上面的代码是通过我写的这个小框架自动生成，我这两天除了写了点测试代码外，没有写过一行代码，汗中．．．．．．(这么多行代码我哪一两天能写的完呀)，我定义了一张属性为５个整型属性的表（数据模型），然后把这张表映射到模板文件中，就直接生成上面我写的代码了，因此，＂待排序的字段不是5个，而是3个或10个＂，只要更改表结构（数据模型）就可以了，完全不用改一行代码．
呵呵，几位大侠的功底比我深厚多了，特别的，creation-zy的拼凑方法给让偶学到很多，我只不过是刚好看到这么一个需求，然后我写的模板代码正好有点关系，所以就拿过来实验一下，而你们是一会就唰唰唰写出来了，这是偶不能比的呀，偶现在正好在研究这些东西呢，有空可以到偶在csdn的博客(地址　http://blog.csdn.net/design1 )多指点指点，期待中．．．
　　

creation-zy · 2008-09-14

哈哈——果然是自动代码生成。高！[

]
既然是自动生成的代码，是不是可以考虑生成非递归的版本以达到更高的效率。毕竟递归
这个模式本身就可以部分取代绝大多数的重复代码，而非递归的代码则往往因为重复代码过
多而难以编写及阅读。
多语言代码自动生成机制我也在研究，希望多多交流

design1 · 2008-09-14

过奖了,代码自动生成主要是简化重复劳动,本身没什么的
"既然是自动生成的代码，是不是可以考虑生成非递归的版本以达到更高的效率。毕竟递归
这个模式本身就可以部分取代绝大多数的重复代码，而非递归的代码则往往因为重复代码过
多而难以编写及阅读。"---这个完全可以,谈到这里,偶顺便就多谈一点,目前的很多开发存在一个问题就是很多东西再做重复劳动,比如楼主的例子,我相信已经有很多可用的方案了,但一般这些方法基本上一是都是基于特定的应用,二是都比较私人化,当下一个类似要求提出来的时候,对于不了解的人来说,可能又要仔细去研究一下,然后再写一次,如此反复
当时我就想如果这些已经讨论过并且很好的方案(比如creation-zy的拼凑法)能够有一个合适的机制让下一个类似的需求出现的时候,不用再去重复研究,那么将是一件非常好的事情,另外一个是数据本身就有很强的可重复性,这样一想,后来就慢慢逐渐找着点感觉,写了个解决类似问题的工具,就是我说的DesignOne
DesignOne目前已经做到和语言无关,也就是说支持多语言,或者说任何语言都支持,其中比较重要的思想就是模板技术,想法是能够把数据很好的穿透到技术中,而一组设计良好的模板基本上就是一个小小的框架性的东西,因此我又萌发了根据自己的经验,尝试着写一些可以用的框架模板出来,这样当下一次有类似需要的时候,我只要设计好数据模型,就直接可以用了,当然,如果别人也有类似的需求,并能够从中受益,那就更好不过了,所以我就开源了,我BLOG里的开源xDom正是基于这样的想法而来的!
以此类推,creation-zy和上面的几位大侠自己肯定也有很多很丰富的经验,如果有兴趣的话,能够把自己多年的技术经验形成框架性的东西,并且模板化,那么我想不仅自己能够受益,可能的话,也可以让很多人受益-------使用者只管设计数据模型,设计好后,大部分代码就可以产生了!当然,产生的代码是实用的,高效的,就比如creation-zy的拼凑法,可以说就是提供一个专家经验库,通过模板技术,并且这些库能够很快的用到实际中．
呵呵,扯远了，感觉有很多想法很接近呀

design1 · 2008-09-14

呵呵，看过creation-zy大侠的笔记后，发现在这方面已经做了非常之多的工作，偶上面最后的话冒失了，收回，哈哈．．．．

大器晚成 · 2008-09-14

看到高手的代码真佩服，说说我的排序；
先把上述数据添加到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。

creation-zy · 2008-09-15

用数据库的排序机制来做是一个更加通用的方案——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中可以包含复杂表达式！），确实是一个选择（可
以不用挖空心思想算法，少死很多脑细胞但也只能在数据量不大的情况使用，否则光填
充数据就有的等啦）。

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

design1

Unregistered / Unconfirmed

guth

Unregistered / Unconfirmed

creation-zy

Unregistered / Unconfirmed

孙伟

Unregistered / Unconfirmed

design1

Unregistered / Unconfirmed

creation-zy

Unregistered / Unconfirmed

design1

Unregistered / Unconfirmed

creation-zy

Unregistered / Unconfirmed

design1

Unregistered / Unconfirmed

design1

Unregistered / Unconfirmed

creation-zy

Unregistered / Unconfirmed

creation-zy

Unregistered / Unconfirmed

xingxin00

Unregistered / Unconfirmed

LeeChange

Unregistered / Unconfirmed

design1

Unregistered / Unconfirmed

creation-zy

Unregistered / Unconfirmed

design1

Unregistered / Unconfirmed

design1

Unregistered / Unconfirmed

大器晚成

Unregistered / Unconfirmed

creation-zy

Unregistered / Unconfirmed

Similar threads