program sortucs4;

{
    Sorter.
    For GNU/Linux 64 bit version.
    Version: 2.0 - with hybrid QuickSort + MergeSort
    Written on FreePascal (https://freepascal.org/).
    Copyright (C) 2025  Artyomov Alexander
    Used https://chat.deepseek.com/
    http://self-made-free.ru/
    aralni@mail.ru

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
}

{$MODE OBJFPC}{$H+}
{$CODEPAGE UTF8}
{$INLINE ON}
{$RANGECHECKS ON}

uses
  SysUtils, ucs4unit, ucs4opunit;

const
  INSERTION_SORT_THRESHOLD = 16;  // Используем insertion sort для маленьких массивов
  MERGE_THRESHOLD = 64;           // Порог для переключения на merge sort

type
  TSortOptions = record
    InputFile: string;
    IsTable: Boolean;
    ColumnIndex: LongInt;
    Delimiter: ucs4;
  end;

  TSortItem = packed object(ucs4)
    s: string;
  public
    procedure ExtractField;
  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;

procedure Cleanup;
var f: LongInt;
begin
for f := 0 to High(Lines) do Lines[f].Clear;
SetLength(Lines, 0);
Options.Delimiter.Clear;
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;

procedure TSortItem.ExtractField;
var
  u: ucs4;
  f, ff, m1, FieldCount: LongInt;
begin
  Init;
  m1 := 0;
  FieldCount := 0;
  u := s;
    for f := 0 to u.Length do // Обратите внимание на <= для обработки последнего символа
    begin
      // Проверяем на разделитель или конец строки
      if (f = u.Length) or (u[f] = Options.Delimiter[0]) then
      begin
        if FieldCount = Options.ColumnIndex then
        begin
          Init(f - m1);
          for ff := 0 to self.Length-1 do
            self[ff] := u[m1 + ff];
          Break;
        end;
        Inc(FieldCount);
        m1 := f + 1; // Следующее поле начинается после разделителя
      end;
    end;
  u.Clear;
end;

function ReadLines(const FileName: string): TSortItems;
var
  F: Text;
  Line: string;
  Count: LongInt;
begin
  Result := nil;
  if not FileExists(FileName) then
  begin
    Writeln('Ошибка: файл не найден');
    Cleanup;
    Halt(1);
  end;

  AssignFile(F, FileName);
  FileMode := 0;
  Reset(F);
  Count := 0;
  while not Eof(F) do
  begin
    Readln(F, Line);
    Inc(Count);
  end;

  WriteLn('Файл содержит ', Count, ' строк');
  if Count < 2 then begin
    Close(F);
    Cleanup;
    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].ExtractField;
      Inc(Count);
      end;
    end else begin
      while not Eof(F) do
      begin
        Readln(F, Line);
        Result[Count].s := Line;
        ucs4(Result[Count]) := Line;
      Inc(Count);
      end;
    end;

  Close(F);
end;

function MyMin(a,b:DWord):DWord; register; // штатная функция не стала работать с DWord
begin
if a < b then Exit(a) else Exit(b);
end;

function CompareLines(const a, b: ucs4): TCmpResult; register;
var
  i: LongInt;
begin
  // Сравниваем посимвольно
  for i := 0 to MyMin(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;

// Insertion sort для маленьких массивов
procedure InsertionSort(var A: TSortItems; L, R: LongInt); inline;
var
  I, J: LongInt;
  Temp: TSortItem;
begin
  for I := L + 1 to R do
  begin
    Temp := A[I];
    J := I - 1;
    while (J >= L) and (CompareLines(A[J], Temp) = crAbove) do
    begin
      A[J + 1] := A[J];
      Dec(J);
    end;
    A[J + 1] := Temp;
  end;
end;

// Процедура для быстрой сортировки (QuickSort) с улучшениями
procedure QuickSort(var A: TSortItems; L, R: LongInt); inline;
var
  I, J: LongInt;
  Pivot: ucs4;
  Temp: TSortItem;
begin
  if R - L <= INSERTION_SORT_THRESHOLD then
  begin
    InsertionSort(A, L, R);
    Exit;
  end;

  // Выбор медианы из трех для улучшения производительности
  I := (L + R) shr 1;
  if CompareLines(A[L], A[I]) = crAbove then
  begin
    Temp := A[L];
    A[L] := A[I];
    A[I] := Temp;
  end;
  if CompareLines(A[L], A[R]) = crAbove then
  begin
    Temp := A[L];
    A[L] := A[R];
    A[R] := Temp;
  end;
  if CompareLines(A[I], A[R]) = crAbove then
  begin
    Temp := A[I];
    A[I] := A[R];
    A[R] := Temp;
  end;
  
  Pivot := A[I];
  I := L;
  J := R;
  
  repeat
    while CompareLines(A[I], Pivot) = crBelow do Inc(I);
    while CompareLines(A[J], 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;

// Процедура слияния для MergeSort
procedure Merge(var A: TSortItems; L, M, R: LongInt; var Temp: TSortItems);
var
  I, J, K: LongInt;
begin
  I := L;
  J := M + 1;
  K := 0;
  
  // Сливаем два подмассива во временный массив
  while (I <= M) and (J <= R) do
  begin
    if CompareLines(A[I], A[J]) <> crAbove then
    begin
      Temp[K] := A[I];
      Inc(I);
    end
    else
    begin
      Temp[K] := A[J];
      Inc(J);
    end;
    Inc(K);
  end;
  
  // Дописываем оставшиеся элементы
  while I <= M do
  begin
    Temp[K] := A[I];
    Inc(I);
    Inc(K);
  end;
  
  while J <= R do
  begin
    Temp[K] := A[J];
    Inc(J);
    Inc(K);
  end;
  
  // Копируем обратно в основной массив
  Move(Temp[0], A[L], K * SizeOf(TSortItem));
end;

// Рекурсивная процедура MergeSort
procedure MergeSortInternal(var A: TSortItems; L, R: LongInt; var Temp: TSortItems);
var
  M: LongInt;
begin
  if R - L <= MERGE_THRESHOLD then
  begin
    QuickSort(A, L, R);
    Exit;
  end;
  
  M := (L + R) shr 1;
  MergeSortInternal(A, L, M, Temp);
  MergeSortInternal(A, M + 1, R, Temp);
  Merge(A, L, M, R, Temp);
end;

// Основная процедура сортировки с гибридным подходом
procedure SortLines(var Lines: TSortItems);
var
  Temp: TSortItems;
begin
  if Length(Lines) <= INSERTION_SORT_THRESHOLD then
  begin
    InsertionSort(Lines, 0, High(Lines));
    Exit;
  end;
  
  if Length(Lines) <= MERGE_THRESHOLD then
  begin
    QuickSort(Lines, 0, High(Lines));
    Exit;
  end;
  
  // Используем MergeSort для больших массивов
  SetLength(Temp, Length(Lines));
  try
    MergeSortInternal(Lines, 0, High(Lines), Temp);
  finally
    SetLength(Temp, 0);
  end;
end;

var
  fp: TextFile;
  f: Int64;
  StartTime, EndTime: TDateTime;
begin
  if (ParamCount = 0) or ((ParamCount >= 1) and ((ParamStr(1)='--help') or (ParamStr(1)='-h'))) then
  begin
    PrintHelp;
    Halt(0);
  end;

  Options := ParseCommandLine;
  
  StartTime := Now;
  Lines := ReadLines(Options.InputFile);
  WriteLn('Файл загружен в память за ', FormatDateTime('nn:ss.zzz', Now - StartTime));

  WriteLn('Начинается сортировка...');
  StartTime := Now;
  SortLines(Lines);
  EndTime := Now;
  WriteLn('Сортировка завершена за ', FormatDateTime('nn:ss.zzz', EndTime - StartTime));

  // Запись обратно в файл
  StartTime := Now;
  AssignFile(fp, Options.InputFile);
  FileMode := 1;
  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('Файл записан за ', FormatDateTime('nn:ss.zzz', Now - StartTime));

  Cleanup;
  
  Writeln('Файл "', Options.InputFile, '" успешно отсортирован.');
  Writeln('Общее время работы: ', FormatDateTime('nn:ss.zzz', Now - StartTime));
end.