Ну для соре
вно
ваний на скорость эта
версия была я
вно не пригодной. Это была экспериментальная
версия с сортиро
вкой "пузырьком". Показал её только потому, что был задан этот
вопрос.
Я изменил подход к работе кода - теперь там более я
вно используется ucs4 и код стал
в целом стройнее и сно
ва запустил deepseek.com с одной задачей: заменить "пузырьком" на QuickSort. Заодно сделан шаг от экспериментальной
в сторону бета
версии. В таком
виде можно и по скоростям соре
вно
вание устроить - это интересная мысль. Так что я жду здесь те самые "д
ве строчки" кода с которыми можно устроить соре
вно
вание. Это так же улучшит от
вет на заданный
вопрос, показа
в разные пути к его решению.
- Код: Выделить всё
program sortucs4;
{$MODE OBJFPC}{$H+}
{$CODEPAGE UTF8}
{$INLINE ON}
// GNU AGPLv3
uses
SysUtils, ucs4unit, ucs4opunit, LazUTF8, Math;
type
TSortOptions = record
InputFile: string;
IsTable: Boolean;
ColumnIndex: LongInt;
Delimiter: ucs4;
end;
TSortItem = record
s: string;
u: ucs4;
end;
TSortItems = array of TSortItem;
TCmpResult = (crBelow, crEqual, crAbove);
var
Options: TSortOptions;
Lines: TSortItems;
procedure PrintHelp;
begin
Writeln('Использование:');
Writeln(' sortucs4 - выводит эту справку');
Writeln(' sortucs4 <файл> - сортирует строки файла UTF-8');
Writeln(' sortucs4 <файл> <столбец> - сортирует таблицу (разделитель - табуляция) по указанному столбцу');
Writeln(' sortucs4 <файл> <столбец> <разделитель> - сортирует таблицу с указанным разделителем');
end;
function ParseCommandLine: TSortOptions;
begin
Result.InputFile := '';
Result.IsTable := False;
Result.ColumnIndex := 0;
if ParamCount = 0 then Exit;
Result.InputFile := ParamStr(1);
if ParamCount >= 2 then
begin
Result.IsTable := True;
if not TryStrToInt(ParamStr(2), Result.ColumnIndex) then
begin
Writeln('Ошибка: номер столбца должен быть целым числом');
Halt(1);
end;
Result.ColumnIndex := Result.ColumnIndex - 1; // Переводим в 0-based индекс
end;
if ParamCount >= 3 then
begin
Result.Delimiter := ParamStr(3);
end else Result.Delimiter := #9;
end;
function ExtractField(const Line: string): ucs4; register;
var
ucsLine: ucs4;
StartPos, EndPos, FieldCount, i: LongInt;
begin
ucsLine := Line;
Result.Init;
StartPos := 0;
FieldCount := 0;
for i := 0 to ucsLine.Length - 1 do
begin
if ucsLine[i] = options.Delimiter[0] then
begin
if FieldCount = options.ColumnIndex then begin
for EndPos := StartPos to i - 1 do
Result := Result + ucsLine[EndPos];
Exit;
end;
Inc(FieldCount);
StartPos := i + 1;
end;
end;
// Добавляем последнее поле
if FieldCount = options.ColumnIndex then begin
for EndPos := StartPos to ucsLine.Length - 1 do
Result := Result + ucsLine[EndPos];
end;
end;
function ReadLines(const FileName: string): TSortItems;
var
F: TextFile;
Line: string;
Count: LongInt;
begin
Result := nil;
if not FileExists(FileName) then
begin
Writeln('Ошибка: файл не найден');
Halt(1);
end;
AssignFile(F, FileName);
Reset(F);
try
Count := 0;
while not Eof(F) do
begin
Readln(F, Line);
Inc(Count);
end;
WriteLn('Файл содержит ', Count, ' строк');
if Count < 2 then begin
CloseFile(F);
Halt(0);
end;
SetLength(Result, Count);
Reset(F);
Count := 0;
if options.IsTable then begin
while not Eof(F) do
begin
Readln(F, Line);
Result[Count].s := Line;
Result[Count].u := ExtractField(Line);
Inc(Count);
end;
end else begin
while not Eof(F) do
begin
Readln(F, Line);
Result[Count].s := Line;
Result[Count].u := Line;
Inc(Count);
end;
end;
finally
CloseFile(F);
end;
end;
function CompareLines(const a, b: ucs4): TCmpResult; register;
var
i: LongInt;
begin
// Сравниваем посимвольно
for i := 0 to Min(a.Length, b.Length) - 1 do
begin
if a[i] < b[i] then Exit(crBelow);
if a[i] > b[i] then Exit(crAbove);
end;
// Если все символы совпадают, более короткая строка считается меньшей
if a.Length < b.Length then Exit(crBelow);
if a.Length > b.Length then Exit(crAbove);
Exit(crEqual);
end;
// Процедура для быстрой сортировки (QuickSort)
procedure QuickSort(var A: TSortItems; L, R: LongInt); inline;
var
I, J: LongInt;
Pivot: ucs4;
Temp: TSortItem;
begin
if L >= R then Exit;
I := L;
J := R;
Pivot := A[(L + R) div 2].u;
repeat
while CompareLines(A[I].u, Pivot) = crBelow do Inc(I);
while CompareLines(A[J].u, Pivot) = crAbove do Dec(J);
if I <= J then
begin
if I < J then
begin
Temp := A[I];
A[I] := A[J];
A[J] := Temp;
end;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then QuickSort(A, L, J);
if I < R then QuickSort(A, I, R);
end;
procedure SortLines(var Lines: TSortItems);
begin
if Length(Lines) < 2 then Exit;
QuickSort(Lines, 0, High(Lines));
end;
var
fp: TextFile;
f: Int64;
begin
if ParamCount = 0 then
begin
PrintHelp;
Halt(0);
end;
Options := ParseCommandLine;
Lines := ReadLines(Options.InputFile);
WriteLn('Файл загружен в память. Начинается сортировка.');
SortLines(Lines);
// Запись обратно в файл
AssignFile(fp, Options.InputFile);
try
ReWrite(fp); // Открываем файл для перезаписи
for f := 0 to High(Lines)-1 do begin
WriteLn(fp, Lines[f].s);
end;
Write(fp, Lines[High(Lines)].s);
finally
CloseFile(fp);
end;
Writeln('Файл "', Options.InputFile, '" успешно отсортирован.');
end.
- Код: Выделить всё
unit ucs4unit;
{$MODE OBJFPC}{$H+}
{$RANGECHECKS ON}
{$OPTIMIZATION LEVEL3}
{$INLINE ON}
// GNU AGPLv3
interface
uses SysUtils, LazUTF8;
type
ucs4 = packed object
private
FData: PDWord;
FLength: DWord;
FCapacity: DWord;
procedure Grow(MinCapacity: DWord); inline;
function GetChar(Index: DWord): DWord; inline;
procedure SetChar(Index: DWord; Value: Dword); inline;
public
property Length: DWord read FLength;
property Chars[Index: DWord]: DWord read GetChar write SetChar; default;
procedure Init; inline;
procedure Init(l:DWord); inline;
procedure Clear; inline;
procedure Reverse;
function IsRTL: Boolean;
function Concat(const S: ucs4): ucs4;
procedure FromUTF8(const S: string);
function ToUTF8: string;
end;
implementation
procedure ucs4.Init;
begin
FData := nil;
FLength := 0;
FCapacity := 0;
end;
procedure ucs4.Init(l:DWord);
begin
FLength := l;
FCapacity := l;
FData := GetMem(l);
end;
procedure ucs4.Grow(MinCapacity: DWord);
var
NewCapacity: DWord;
begin
if FCapacity = 0 then
NewCapacity := 8
else
NewCapacity := FCapacity * 2;
if NewCapacity < MinCapacity then
NewCapacity := MinCapacity;
ReallocMem(FData, NewCapacity * SizeOf(DWord));
FCapacity := NewCapacity;
end;
function ucs4.GetChar(Index: DWord): DWord; inline;
begin
{$IFDEF RANGECHECKS}
if Index >= FLength then
raise Exception.Create('Index out of bounds');
{$ENDIF}
Exit(FData[Index]);
end;
procedure ucs4.SetChar(Index: DWord; Value: Dword); inline;
begin
{$IFDEF RANGECHECKS}
if Index >= FLength then
raise Exception.Create('Index out of bounds');
{$ENDIF}
FData[Index] := Value;
end;
procedure ucs4.Clear;
begin
if FData <> nil then
begin
FreeMem(FData);
FData := nil;
end;
FLength := 0;
FCapacity := 0;
end;
procedure ucs4.Reverse;
var
I: DWord;
Tmp: DWord;
P1, P2: PDWord;
begin
if FLength <= 1 then Exit;
P1 := @FData[0];
P2 := @FData[FLength-1];
while P1 < P2 do
begin
Tmp := P1^;
P1^ := P2^;
P2^ := Tmp;
Inc(P1);
Dec(P2);
end;
end;
function ucs4.IsRTL: Boolean;
var
I: DWord;
begin
for I := 0 to FLength - 1 do
if (FData[I] >= $0590) and (FData[I] <= $08FF) then
Exit(True);
Result := False;
end;
function ucs4.Concat(const S: ucs4): ucs4;
begin
Result.Init;
if Self.FLength + S.FLength = 0 then Exit;
GetMem(Result.FData, (Self.FLength + S.FLength) * SizeOf(DWord));
Result.FCapacity := Self.FLength + S.FLength;
Result.FLength := Result.FCapacity;
if Self.FLength > 0 then
Move(Self.FData^, Result.FData^, Self.FLength * SizeOf(DWord));
if S.FLength > 0 then
Move(S.FData^, Result.FData[Self.FLength], S.FLength * SizeOf(DWord));
end;
procedure ucs4.FromUTF8(const S: string);
var
UTF8Ptr: PChar;
CharLen: Integer;
Count, Pos: DWord;
begin
Clear;
if S = '' then Exit;
// Первый проход - подсчет символов
Count := 0;
UTF8Ptr := PChar(S);
while UTF8Ptr^ <> #0 do
begin
UTF8CodepointToUnicode(UTF8Ptr, CharLen);
Inc(UTF8Ptr, CharLen);
Inc(Count);
end;
// Выделение памяти
if Count > FCapacity then
Grow(Count);
FLength := Count;
// Второй проход - заполнение
UTF8Ptr := PChar(S);
Pos := 0;
while UTF8Ptr^ <> #0 do
begin
FData[Pos] := UTF8CodepointToUnicode(UTF8Ptr, CharLen);
Inc(UTF8Ptr, CharLen);
Inc(Pos);
end;
end;
function ucs4.ToUTF8: string;
var
I, Len: Integer;
P: PChar;
begin
if FLength = 0 then Exit('');
// Максимально возможный размер (4 байта на символ)
SetLength(Result, FLength * 4);
P := PChar(Result);
for I := 0 to FLength - 1 do
Inc(P, UnicodeToUTF8(FData[I], P));
// Корректируем длину под реальный размер
SetLength(Result, P - PChar(Result));
end;
end.
- Код: Выделить всё
unit ucs4opunit;
{$MODE OBJFPC}{$H+}
{$RANGECHECKS ON}
{$OPTIMIZATION LEVEL3}
{$INLINE ON}
{$CODEPAGE UTF8}
// GNU AGPLv3
interface
uses ucs4unit;
operator = (s1,s2:ucs4)r:bytebool;
operator = (s1:ucs4;s2:string)r:bytebool;
operator + (s1,s2:ucs4)r:ucs4;
operator + (s:ucs4;c:DWord)r:ucs4;
operator := (const s: utf8string)r:ucs4;
implementation
operator = (s1,s2:ucs4)r:bytebool;
var f:LongInt;
begin
if s1.Length <> s2.Length then Exit(false);
for f := 0 to s1.Length-1 do if s1[f] <> s2[f] then Exit(false);
Exit(true);
end;
operator = (s1:ucs4;s2:string)r:bytebool;
var tmp:ucs4;
begin
tmp.Init;
tmp.FromUTF8(s2);
r:= s1=tmp;
tmp.Clear;
end;
operator + (s1,s2:ucs4)r:ucs4;
begin
Exit(s1.Concat(s2));
end;
operator + (s:ucs4;c:DWord)r:ucs4;
var tmp:ucs4;
begin
tmp.Init(1);
tmp[0]:=c;
r := s.Concat(tmp);
tmp.Clear;
end;
operator := (const s: utf8string)r:ucs4;
begin
r.Init;
r.FromUTF8(s);
end;
end.
