Сортировка строк

← →
F1 (2002-10-24 11:06) [0]

Есть задачка: Отсортировать строки в файле(по алфавиту)
При этом главное скорость. Ну и желательно памяти поменьше кушать.Файл большой-100тыс строк, каждая 5-20 символов. Вобщем я написал, сортирует достаточно быстро(на PIII-550 DIMM 320Mb 3..4 секунды), но памяти жрет примерно (5..10)*размер файла. И на компах, где мало оперативки винды начинают колбасить файл подкачки и скорость сразу падает в 10-ки раз. Посмотрите, может кто-нибудь знает способ лучше??? (камешки и пузырики здесь просто отдыхают ;-))))

program ConsoleStr;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows;

type
//Структура листа дерева
PSuperNode=^TSuperNode;
TSuperNode = record
c:char;
NodeNext:PSuperNode;
NodeChild:PSuperNode;
end;

var
FS:TextFile;
Mem,FSize,RSize,CountString,NowString:LongWord;
Root:array[char] of PSuperNode;
S:String;
FileNameO,FileNameS:String;
Mess:Array[0..63] of Char;

//-------Добавление слова в дерево----------
procedure AddSuperNode(Node:PSuperNode;Index:Integer);
var
Fl:Boolean;
N:PSuperNode;
begin
if Index>Length(S) then //смотрим, не кончилось ли слово
begin //слово кончилось
if Node^.NodeChild=Nil then //есть ли дочерние узлы
begin //нет
Mem:=Mem+SizeOf(TSuperNode);
New(Node^.NodeChild);
Node:=Node^.NodeChild;
Node^.NodeNext:=Nil;
Node^.NodeChild:=Nil;
Node^.c:=#0;
inc(CountString);
end else
begin //есть
Mem:=Mem+SizeOf(TSuperNode);
New(N);
N^.NodeChild:=Nil;
N^.c:=#0;
N^.NodeNext:=Node^.NodeChild;
Node^.NodeChild:=N;
inc(CountString);
end;
end else
begin // Слово не кончилось
if Node^.NodeChild=Nil then
begin //дочерних нет
Mem:=Mem+SizeOf(TSuperNode);
New(Node^.NodeChild);
Node:=Node^.NodeChild;
Node^.NodeNext:=Nil;
Node^.NodeChild:=Nil;
Node^.c:=S[Index];
AddSuperNode(Node, Index+1);
end else
begin //дочерние есть
if Node^.NodeChild^.c>S[Index] then
begin //Нужно букву вставлять на первое место
Mem:=Mem+SizeOf(TSuperNode);
New(N);
N^.c:=S[Index];
N^.NodeChild:=Nil;
N^.NodeNext:=Node^.NodeChild;
Node^.NodeChild:=N;
AddSuperNode(N, Index+1);
end else
begin
fl:=true;
Node:=Node^.NodeChild;
while fl do //ищем, куда же вставить букву
begin
if Node^.NodeNext=Nil then fl:=False else
if Node^.NodeNext^.c<=S[Index] then Node:=Node^.NodeNext else
fl:=False;
end;
if Node^.c<>S[Index] then
begin
Mem:=Mem+SizeOf(TSuperNode);
New(N);
N^.c:=S[Index];
N^.NodeChild:=Nil;
N^.NodeNext:=Node^.NodeNext;
Node^.NodeNext:=N;
AddSuperNode(N, Index+1);
end else
begin //если такая буква есть, то не нужно дублировать
AddSuperNode(Node, Index+1);
end;
end;
end;
end;
end;
//-------Сохранение дерева----------
//Здесь уже все отсортированно, просто пробегаем рекурсивно, сохраняем и удаляем.
procedure SaveSuperNode(Node:PSuperNode; st:String);
Var
N,N1:PSuperNode;
begin
N1:=Node;
if Node^.c=#0 then
begin
Writeln(FS,st);
end else
if Node^.NodeChild<>Nil then
begin
st:=st+Node^.c;
Node:=Node^.NodeChild;
repeat
N:=Node^.NodeNext;
SaveSuperNode(Node,st);
Node:=N;
until Node=Nil;
end;
Dispose(N1);
end;

procedure Sort;
var
FO:TextFile;
Tick:Cardinal;
i:Char;
Index:Byte;
Node:PSuperNode;
begin
Writeln("Sort start...");
Tick:=GetTickCount;
Mem:=255*Sizeof(TSuperNode);
for i:=#1 to #255 do
begin
new(Root[i]);
Root[i]^.NodeNext:=Nil;
Root[i]^.NodeChild:=Nil;
Root[i]^.c:=i;
end;
CountString:=0;
NowString:=0;
AssignFile(FO,FileNameO);
Reset(FO);
while not eof(FO) do
begin
repeat
Readln(FO,S);
until Length(S)>0;
AddSuperNode(Root[S[1]],2);
end;
CloseFile(FO);
Writeln("Sort complete...");
Writeln("Save start...");
AssignFile(FS,FileNameS);
Rewrite(FS);
for i:=#1 to #255 do
begin
SaveSuperNode(Root[i],"");
end;
CloseFile(FS);
Tick:=GetTickCount-Tick;
Writeln("Save complete...");
Writeln("Time: "+IntToStr(Tick div 1000)+","+IntToStr(Tick mod 1000)+" seconds");
Writeln("Count word: "+IntToStr(CountString));
Writeln("Count memory: "+IntToStr(Mem));
end;

begin
if ParamCount<>2 then
begin
Mess:="Надо 2 параметра";
AnsiToOem(Mess,Mess);
Writeln(Mess);
Readln;
Halt;
end;
FileNameO:=ParamStr(1);
FileNameS:=ParamStr(2);
Sort;
Readln;
end.

Единственное, что пришло в голову - это создавать дерево в отдельной куче, а потом делать Dispose не каждого узла, а всей кучи хором. Это немного увеличит скорость, но не поможет с подгрузкой файля подкачки.

← →
F1 (2002-10-24 12:30) [1]

Ну что, ни у кого нет вариантов. Никому не приходилось сортировать строки??? Подкидывайте любые идеи, даже если не уверены, что правильные.

← →
ЮЮ (2002-10-24 12:44) [2]

>И на компах, где мало оперативки винды начинают колбасить файл подкачки и скорость сразу падает в 10-ки раз.

Отсортируй раз и храни отсортированным

← →
F1 (2002-10-24 13:21) [3]

ЮЮ, ты бы еще посоветовал комп с собой таскать ;))).
Я ведь заранее не знаю что будет сортироваться.
P.S. Спасибо, хоть один что-то написал
Ешеееее варианты есь??????????????///

← →
VaS (2002-10-24 14:00) [4]

Итак, не найдя никакой связи вопроса с приведенным кодом :) отвечаю на вопрос - сортировка порядка миллиона строк. Считываем строки в TStringList с помощью ReadLn (наиболее быстрая). Далее сортируем перестановками ("быстрая" сортировка). Необходимая память - почти точно размер самого файла. Скорость - наивысшая.

← →
F1 (2002-10-24 14:27) [5]

VaS:
Ты имел ввиду вот это чтоли(см. ниже)
Так это прогрывает в скорости моему вешеприведенному коду(который по-твоему никак не относится к вопросу) почти в 2 раза!!!
Время сортировки моя прога твоя прога
100 тыс строк 3сек 5,5сек
500 тыс строк 18сек 29,5сек
А мне все-таки скорость важнее. Тем более, что при таком раскладе я не могу отслеживать промежуточный результат(%).
И вообще, задачу желательно решить без VCL.

procedure TForm1.SpeedButton1Click(Sender: TObject);
Var
F:TextFile;
S:TStringList;
Tick:DWORD;
begin
Tick:=GetTickCount;
S:=TStringList.Create;
S.LoadFromFile("C:\works\111.txt");
S.Sort;
S.SaveToFile("C:\works\222.txt");
S.Free;
SpeedButton1.Caption:=IntToStr(GetTickCount-Tick);
end;

← →
roadster (2002-10-24 14:57) [6]

Или так: :0)

procedure TForm1.SpeedButton1Click(Sender: TObject);
Var
F:TextFile;
S:TStringList;
Tick:DWORD;
begin
Tick:=GetTickCount;
S:=TStringList.Create;
S.Sorted := True; //!
S.LoadFromFile("C:\works\111.txt");
//S.Sort;
S.SaveToFile("C:\works\222.txt");
S.Free;
SpeedButton1.Caption:=IntToStr(GetTickCount-Tick);
end;

← →
Qpwoe! (2002-10-24 14:59) [7]

Может просто создовать другой файл и сохранять туда в нужном порядке, а потом им заменять старый?

← →
VaS (2002-10-24 15:04) [8]

Ну ты интересный парень, однако :) Во-первых я тебе не говорил использовать TStrings.LoadFromFile(). Во-вторых - сортировать руками, а не Sorted:=true.

← →
F1 (2002-10-24 15:06) [9]

roadster, это ведь тот же хрен, только в левой руке;)))
S.Sorted := True;
это абсолютно тоже самое, что и
S.Sorted;
//////////////////////////////////////////////////
property Sorted: Boolean read FSorted write SetSorted;

procedure TStringList.SetSorted(Value: Boolean);
begin
if FSorted <> Value then
begin
if Value then Sort;
FSorted := Value;
end;
end;

Да, еще обнаружил, что TStringList при больших файлах может вообще повиснуть!!!
Короче этот вариант тоже отдыхает.

← →
F1 (2002-10-24 15:20) [10]

Qpwoe!
>Может просто создовать другой файл и сохранять туда в нужном >порядке, а потом им заменять старый?
1.Если ты не заметил, то файла нужно 2. Исходный и отсортированный.
2.Вопрос в том, как БЫСТРО сохранять в нужном порядке.

VaS
>Ну ты интересный парень, однако :) Во-первых я тебе не говорил >использовать TStrings.LoadFromFile(). Во-вторых - сортировать >руками, а не Sorted:=true.

Sorry, но ведь Sorted:=true итак использует QuickSort. И врядли я реализую его быстрее, чем Borland.
А по поводу LoadFromFile:

Tick:=GetTickCount;
AssignFile(F,"C:\works\111.txt");
reset(F);
S:=TStringList.Create;
while Not(eof(F)) do
begin
Readln(F,Str);
S.Add(Str);
end;
S.Sort;
S.SaveToFile("C:\works\222.txt");
CloseFile(F);
SpeedButton1.Caption:=IntToStr(GetTickCount-Tick);

это немножко ускоряет процесс (~0,3 сек для 100тыс строк), но все равно проигрывает в скорости.

← →
F1 (2002-10-24 15:24) [11]

roadster, я там писал, что Sort и Sorted:=true одно и тоже, извини, не в тему, только сейчас заметил, что ты это поставил до считывания, я тоже так сделал, около минуты подождал и вырубил процесс - вообще тормозит неподетски.

← →
F1 (2002-10-24 15:39) [12]

VaS
Я еще попробовал ручками сортировать, т.е. я считываю и вставляю в нужное место, нужное место искал половинным делением. Чето совсем беда, думал с поиском нужного места я перемудрил, попробовал S.Insert(S.Count div 2, Str) тоже труба. Т.е. Insert оочень медленно работает, так что сортировать полюбому нужно после того, как все считал. А там стандартный Sort по скорости не обогнать. Так что с TStringList никак /8(((

← →
VaS (2002-10-24 16:33) [13]

Ой, извини, что сразу не заметил 8-( У тебя строится бинарное дерево, потом ты его линейно проходишь при сохранении? Тогда быстрее сделать вряд ли получится... Я пас.

← →
NickBat (2002-10-24 16:37) [14]

Не вдавался в подробности вашего текста. Просто быстро решил попробывать проверить скорость сортировки без всяких излишеств. Просто прочитав файл в массив и отсортировав последний сохранить.
Файл 109 тыс. строк, каждая строка где-то 200 символов. Все это дело заняло где-то 3 секунды. Правда Celeron 800 ^)))
Алгоритм сортировки стандартный.

procedure QuickSort(var A: array of string; iLo, iHi: Integer);
var
Lo, Hi: Integer;
Mid, T: string;
begin
Lo := iLo;
Hi := iHi;
Mid := A[(Lo + Hi) div 2];
repeat
while A[Lo] < Mid do Inc(Lo);
while A[Hi] > Mid do Dec(Hi);
if Lo <= Hi then
begin
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickSort(A, iLo, Hi);
if Lo < iHi then QuickSort(A, Lo, iHi);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
f, f1: TextFile;
ss: string;
ar: array of string;
ii: integer;
begin
AssignFile(f,"d:\m.txt");
AssignFile(f1,"d:\s.txt");
Rewrite(f1);
Append(f1);
Reset(f);
ii:=-1;
while not EOF(f)
do begin ReadLn(f,ss); Inc(ii); end;
SetLength(ar,ii+1);
CloseFile(f);
Reset(f);
ii:=0;
while not EOF(f) do
begin
ReadLn(f,ar[ii]);
Inc(ii);
end;
CloseFile(f);
QuickSort(ar,Low(ar),High(ar));
for ii:=Low(ar) to High(ar) do
writeln(f1,ar[ii]);
CloseFile(f1);
ShowMessage(IntToStr(ii));
end;

← →
F1 (2002-10-24 16:38) [15]

А как насчет того, чтобы памяти немножечко(разика в два !8-)) поменьше кушать???

← →
F1 (2002-10-24 16:49) [16]

Nick Bat!!!!
Большое спасибо!!! Работает быстрее и памяти меньше ест!!! Блин, я просто думал, что TStringList.Sort именно QuickSort использует(поэтому руками не стал делать-стормозил), похоже что нет.

P.S. Мы не ищем легких путей 8-)))

← →
VaS (2002-10-24 16:56) [17]

Слушай, а если при считывании строить бинарное дерево из строк? Я вечерком попробую... :)

← →
F1 (2002-10-24 17:06) [18]

VaS:
Я уже пробовал, совсем труба, слишком много сравнений, так как дерево потом становится слишком длинным. Там вообще время минутами нужно измерять.

← →
kull (2002-10-24 17:13) [19]

← →
NickBat (2002-10-24 17:34) [20]

> kull © (24.10.02 17:13)

Да, но TstringList имеет множество других свойств и методов ненужных для этой задачи. А то, что сортировка такая, я и не говорил, что будет что-то оригинальное.
Надо быть проще. :)))

← →
F1 (2002-10-24 17:43) [21]

NickBat!!!
У меня получилось 1,222 сек для 100 тыс
А если сделать
while not EOF(f) do
begin
ReadLn(f); //без ss
Inc(ii);
end;
то 1,14 сек ;-)))
>Надо быть проще. :)))
Это ты прав на 200% !!!

← →
Дмитрий Баранов (2002-10-24 17:44) [22]

А чего ты велосипед изобретаешь? Delphi для этого не очень подходящий инструмент, я же тебе вчера говорил, что добился скорости менее секунды на все-про-все. В С++ есть такая штука, как STL - универсальная библиотека алгоритмов и контейнеров, реализуемая разными разработчиками, которые на сортировке собаку съели и Кнута наизусть знают. Вся твоя задача решается в десяток строк кода и скорости я вчера добился на 600-м пне - менее секунды на-все-про-все (собственно сортировка ~800 мс), при том, что у меня STL не из лучших ( от Microsoft; борландовый еще хуже ) - т.е. показатели можно улучшить вдвое. Вынеси ее в DLL и не мучайся.
Это первое. Во-вторых, слишком много многократных выделений памяти. Либо закажи сразу ведро, либо вообще от использования кучи откажись, а стек сделай побольше ( как получится :). Про string забудь ( статья на RSDN про это есть ), используй array[0..сколько-надо] of char с ноликом в конце по необходимости.

Сортировка строк Найти похожие ветки