unit ucs4functionsunit;

{
    UCS4 Functions Unit - дополнительные функции для работы с UCS4
    Для GNU/Linux 64 bit версии
    Версия: 1.0
    Написано на FreePascal (https://freepascal.org/)
    Copyright (C) 2025  Artyomov Alexander
    http://self-made-free.ru/
    aralni@mail.ru

    Лицензия: GNU Affero General Public License
}

{$MODE OBJFPC}{$H+}
{$RANGECHECKS ON}
{$OPTIMIZATION LEVEL3}
{$INLINE ON}
{$CODEPAGE UTF8}
{$ASMMODE INTEL}

interface

uses
  SysUtils, ucs4unit, ucs4opunit,Math,LazUTF8;

function Pos(const SubStr, Str: ucs4): Integer;
function RPos(const SubStr, Str: ucs4): Integer;
function IfThen(Condition: Boolean; const TrueStr, FalseStr: ucs4): ucs4; overload;
function IfThen(Condition: Boolean; const TrueStr: ucs4): ucs4; overload;
function Split(const Str: ucs4; Delimiter: DWord): TUC4Array;
function Join(const Arr: TUC4Array; Delimiter: DWord): ucs4;
function ToLower(const Str: ucs4): ucs4;
function ToUpper(const Str: ucs4): ucs4;
function Trim(const Str: ucs4): ucs4;
function StartsWith(const Str, SubStr: ucs4): Boolean;
function EndsWith(const Str, SubStr: ucs4): Boolean;
function Contains(const Str, SubStr: ucs4): Boolean;
function LevenshteinDistance(const S1, S2: ucs4): Integer;
function EnhancedLevenshteinSimilarity(const S1, S2: ucs4): Double;
function NormalizeForAI(const Str: ucs4): ucs4;
function RemovePunctuation(const Str: ucs4): ucs4;
function TokenizeForNLP(const Str: ucs4): TUC4Array;
function UnicodeToLower(c: DWord): DWord;
function UnicodeToUpper(c: DWord): DWord;
function IsWhiteSpace(c: DWord): Boolean;
function IsPunctuation(c: DWord): Boolean;
function Copy(const Str: ucs4; StartPos, Length: Integer): ucs4; overload;
function Copy(const Str: ucs4; StartPos: Integer): ucs4; overload;
function Mid(const Str: ucs4; StartPos, Length: Integer): ucs4; overload;
function Mid(const Str: ucs4; StartPos: Integer): ucs4; overload;
function Left(const Str: ucs4; Count: Integer): ucs4;
function Right(const Str: ucs4; Count: Integer): ucs4;

implementation

{$I asmf.inc}

function UnicodeToLower(c: DWord): DWord;
begin
  // --- Кириллица ---
  // Русский Ё, Ѐ
  if (c = $0401) then Exit($0451);
  if (c = $0400) then Exit($0450);
  // Основной диапазон (А-Я)
  if (c >= $0410) and (c <= $042F) then Exit(c + $20);

  // --- Латиница ---
  // Основной диапазон (A-Z)
  if (c >= $0041) and (c <= $005A) then Exit(c + $20);
  // Расширенная латиница (с диакритикой)
  if (c >= $00C0) and (c <= $00D6) then Exit(c + $20);
  if (c >= $00D8) and (c <= $00DE) then Exit(c + $20);
  if (c >= $0100) and (c <= $012E) and (c mod 2 = 0) then Exit(c + 1);
  if (c >= $0132) and (c <= $0136) and (c mod 2 = 0) then Exit(c + 1);
  // и т.д. для других диапазонов латиницы

  // --- Греческий ---
  if (c >= $0386) and (c <= $0388) then Exit(c + 1);
  if (c >= $0389) and (c <= $038A) then Exit(c + 1);
  if (c >= $038C) and (c <= $038C) then Exit(c + 1);
  if (c >= $038E) and (c <= $038F) then Exit(c + 1);
  if (c >= $0391) and (c <= $03A1) then Exit(c + $20);
  if (c >= $03A3) and (c <= $03AB) then Exit(c + $20);

  // --- Коптский ---
  if (c >= $2C80) and (c <= $2CEA) then Exit(c + 1);

  // --- Армянский ---
  if (c >= $0531) and (c <= $0556) then Exit(c + $30);

// Если нет простого преобразования, возвращаем исходный символ.
Exit(c);
end;

function UnicodeToUpper(c: DWord): DWord;
begin
  // --- Кириллица ---
  // Русский ё, ѐ
  if (c = $0451) then Exit($0401);
  if (c = $0450) then Exit($0400);
  // Основной диапазон (а-я)
  if (c >= $0430) and (c <= $044F) then Exit(c - $20);

  // --- Латиница ---
  // Основной диапазон (a-z)
  if (c >= $0061) and (c <= $007A) then Exit(c - $20);
  // Расширенная латиница (с диакритикой)
  if (c >= $00E0) and (c <= $00F6) then Exit(c - $20);
  if (c >= $00F8) and (c <= $00FE) then Exit(c - $20);
  if (c >= $0101) and (c <= $012F) and (c mod 2 = 1) then Exit(c - 1);
  if (c >= $0133) and (c <= $0137) and (c mod 2 = 1) then Exit(c - 1);
  // и т.д. для других диапазонов латиницы

  // --- Греческий ---
  if (c >= $03AC) and (c <= $03AE) then Exit(c - 1);
  if (c >= $03AF) and (c <= $03AF) then Exit(c - 1);
  if (c >= $03B1) and (c <= $03C1) then Exit(c - $20);
  if (c >= $03C3) and (c <= $03CB) then Exit(c - $20);

  // --- Коптский ---
  if (c >= $2C81) and (c <= $2CEB) then Exit(c - 1);

  // --- Армянский ---
  if (c >= $0561) and (c <= $0586) then Exit(c - $30);

// Если нет простого преобразования, возвращаем исходный символ.
Exit(c);
end;

function IsWhiteSpace(c: DWord): Boolean;
begin
  case c of
    $0020, $00A0, $0009, $000A, $000B, $000C, $000D,
    $1680, $2000, $2001, $2002, $2003, $2004, $2005,
    $2006, $2007, $2008, $2009, $200A, $2028, $2029,
    $202F, $205F, $3000: Result := True;
    else Result := False;
  end;
end;

function IsPunctuation(c: DWord): Boolean;
begin
  // Основные ASCII знаки препинания
  if (c >= $0021) and (c <= $002F) then Exit(True);
  if (c >= $003A) and (c <= $0040) then Exit(True);
  if (c >= $005B) and (c <= $0060) then Exit(True);
  if (c >= $007B) and (c <= $007E) then Exit(True);

  // Дополнительные знаки препинания
  case c of
    $00A1..$00BF, $2010..$2027, $2030..$2043, 
    $2045..$2051, $2053..$205E, $207D, $207E,
    $208D, $208E, $2329, $232A, $2768..$2775,
    $27C5, $27C6, $27E6..$27EF, $2983..$2998,
    $29D8..$29DB, $29FC, $29FD, $3001..$3003,
    $3008..$3011, $3014..$301F, $3030, $303D,
    $30A0, $30FB, $FD3E, $FD3F, $FE30..$FE52,
    $FE54..$FE61, $FE63, $FE68, $FE6A, $FE6B,
    $FF01..$FF03, $FF05..$FF0A, $FF0C..$FF0F,
    $FF1A, $FF1B, $FF1F, $FF20, $FF3B..$FF3D,
    $FF3F, $FF5B, $FF5D, $FF5F..$FF65: Result := True;
    else Result := False;
  end;
end;

function Pos(const SubStr, Str: ucs4): Integer;
var
  i, j: Integer;
  found: Boolean;
begin
  if (SubStr.Length = 0) or (Str.Length = 0) or (SubStr.Length > Str.Length) then
    Exit(0);

  for i := 0 to Str.Length - SubStr.Length do
  begin
    found := True;
    for j := 0 to SubStr.Length - 1 do
      if Str[i + j] <> SubStr[j] then
      begin
        found := False;
        Break;
      end;
    if found then
      Exit(i + 1); // 1-based index
  end;
  Result := 0;
end;

function RPos(const SubStr, Str: ucs4): Integer;
var
  i, j: Integer;
  found: Boolean;
begin
  if (SubStr.Length = 0) or (Str.Length = 0) or (SubStr.Length > Str.Length) then
    Exit(0);

  for i := Str.Length - SubStr.Length downto 0 do
  begin
    found := True;
    for j := 0 to SubStr.Length - 1 do
      if Str[i + j] <> SubStr[j] then
      begin
        found := False;
        Break;
      end;
    if found then
      Exit(i + 1); // 1-based index
  end;
  Result := 0;
end;

function IfThen(Condition: Boolean; const TrueStr, FalseStr: ucs4): ucs4;
begin
  if Condition then
    Result := TrueStr
  else
    Result := FalseStr;
end;

function IfThen(Condition: Boolean; const TrueStr: ucs4): ucs4;
begin
  if Condition then
    Result := TrueStr
  else
    Result := Default(ucs4);
end;

function Split(const Str: ucs4; Delimiter: DWord): TUC4Array;
var
  i, StartIdx, Count: Integer;
begin
  if Str.Length = 0 then
    Exit(nil);

  // Подсчет количества разделителей
  Count := 0;
  for i := 0 to Str.Length - 1 do
    if Str[i] = Delimiter then
      Inc(Count);

  SetLength(Result, Count + 1);
  StartIdx := 0;
  Count := 0;

  for i := 0 to Str.Length - 1 do
    if Str[i] = Delimiter then
    begin
      Result[Count].Init(i - StartIdx);
      Move(Str.FData[StartIdx], Result[Count].FData^, (i - StartIdx) * SizeOf(DWord));
      Inc(Count);
      StartIdx := i + 1;
    end;

  // Последний сегмент
  Result[Count].Init(Str.Length - StartIdx);
  if Str.Length - StartIdx > 0 then
    Move(Str.FData[StartIdx], Result[Count].FData^, (Str.Length - StartIdx) * SizeOf(DWord));
end;

function Join(const Arr: TUC4Array; Delimiter: DWord): ucs4;
var
  i, TotalLength, Pos: Integer;
begin
  if Length(Arr) = 0 then
    Exit(Default(ucs4));

  // Вычисление общей длины
  TotalLength := 0;
  for i := 0 to High(Arr) do
    Inc(TotalLength, Arr[i].Length);

  // Добавляем место для разделителей
  Inc(TotalLength, Length(Arr) - 1);

  Result.Init(TotalLength);
  Pos := 0;

  for i := 0 to High(Arr) do
  begin
    if (i > 0) and (TotalLength > 0) then
    begin
      Result[Pos] := Delimiter;
      Inc(Pos);
    end;

    if Arr[i].Length > 0 then
    begin
      Move(Arr[i].FData^, Result.FData[Pos], Arr[i].Length * SizeOf(DWord));
      Inc(Pos, Arr[i].Length);
    end;
  end;
end;

function ToLower(const Str: ucs4): ucs4;
var
  i: Integer;
begin
  Result.Init(Str.Length);
  for i := 0 to Str.Length - 1 do
    Result[i] := UnicodeToLower(Str[i]);
end;

function ToUpper(const Str: ucs4): ucs4;
var
  i: Integer;
begin
  Result.Init(Str.Length);
  for i := 0 to Str.Length - 1 do
    Result[i] := UnicodeToUpper(Str[i]);
end;

function Trim(const Str: ucs4): ucs4;
var
  Start, Len: Integer;
begin
  if Str.Length = 0 then
    Exit(Str);

  // Находим первый не-пробельный символ
  Start := 0;
  while (Start < Str.Length) and (IsWhiteSpace(Str[Start])) do
    Inc(Start);

  // Находим последний не-пробельный символ
  Len := Str.Length;
  while (Len > Start) and (IsWhiteSpace(Str[Len - 1])) do
    Dec(Len);

  Len := Len - Start;
  if Len <= 0 then
    Exit(Default(ucs4));

  Result.Init(Len);
  Move(Str.FData[Start], Result.FData^, Len * SizeOf(DWord));
end;

function StartsWith(const Str, SubStr: ucs4): Boolean;
var
  i: Integer;
begin
  if SubStr.Length > Str.Length then
    Exit(False);

  for i := 0 to SubStr.Length - 1 do
    if Str[i] <> SubStr[i] then
      Exit(False);

  Result := True;
end;

function EndsWith(const Str, SubStr: ucs4): Boolean;
var
  i, Offset: Integer;
begin
  if SubStr.Length > Str.Length then
    Exit(False);

  Offset := Str.Length - SubStr.Length;
  for i := 0 to SubStr.Length - 1 do
    if Str[Offset + i] <> SubStr[i] then
      Exit(False);

  Result := True;
end;

function Contains(const Str, SubStr: ucs4): Boolean;
begin
  Result := Pos(SubStr, Str) > 0;
end;

function LevenshteinDistance(const S1, S2: ucs4): Integer;
var
  i, j, cost: Integer;
  D: array of array of Integer;
begin
  SetLength(D, S1.Length + 1, S2.Length + 1);

  for i := 0 to S1.Length do
    D[i, 0] := i;
  for j := 0 to S2.Length do
    D[0, j] := j;

  for i := 1 to S1.Length do
    for j := 1 to S2.Length do
    begin
      if S1[i - 1] = S2[j - 1] then
        cost := 0
      else
        cost := 1;

      D[i, j] := Min(Min(D[i-1, j] + 1, D[i, j-1] + 1), D[i-1, j-1] + cost);
    end;

  Result := D[S1.Length, S2.Length];
end;

function EnhancedLevenshteinSimilarity(const S1, S2: ucs4): Double;
var
  Distance: Integer;
  MaxLen: Integer;
begin
  if (S1.Length = 0) and (S2.Length = 0) then Exit(1.0);

  Distance := LevenshteinDistance(S1, S2);
  MaxLen := Max(S1.Length, S2.Length);
  Result := 1.0 - (Distance / MaxLen);

  // Улучшение для коротких строк
  if MaxLen < 5 then
    Result := Result * 0.9; // Снижаем вес для очень коротких совпадений
end;

function NormalizeForAI(const Str: ucs4): ucs4;
var
  i, j: Integer;
  Temp: ucs4;
c:DWord;
begin
  Temp.Init(Str.Length);
  j := 0;

  for i := 0 to Str.Length - 1 do
  begin
    // Приводим к нижнему регистру
    c := UnicodeToLower(Str[i]);

    // Сохраняем пробелы между словами
    if IsWhiteSpace(c) then
    begin
      if (j > 0) and not IsWhiteSpace(Temp[j-1]) then
      begin
        Temp[j] := $20; // ASCII пробел
        Inc(j);
      end;
      Continue;
    end;

    // Удаляем некоторые диакритические знаки (упрощенно)
    case c of
      $00E1, $00E0, $00E2, $00E3, $00E4: c := $0061; // á à â ã ä → a
      $00E9, $00E8, $00EA, $00EB: c := $0065; // é è ê ë → e
      $00ED, $00EC, $00EE, $00EF: c := $0069; // í ì î ï → i
      $00F3, $00F2, $00F4, $00F5, $00F6: c := $006F; // ó ò ô õ ö → o
      $00FA, $00F9, $00FB, $00FC: c := $0075; // ú ù û ü → u
    end;

    // Пропускаем некоторые специальные символы
    case c of
      $0000..($0020-1), $FFFD: begin end;
    else
      Temp[j] := c;
      Inc(j);
    end;
  end;

  // Удаляем возможный пробел в конце
  if (j > 0) and IsWhiteSpace(Temp[j-1]) then
    Dec(j);

  if j = 0 then begin
    Temp.Clear;
    Exit(Default(ucs4));
  end;

  Result.Init(j);
  Move(Temp.FData^, Result.FData^, j * SizeOf(DWord));
  Temp.Clear;
end;

function RemovePunctuation(const Str: ucs4): ucs4;
var
  i, j: Integer;
  Temp: ucs4;
begin
  Temp.Init(Str.Length);
  j := 0;

  for i := 0 to Str.Length - 1 do
    if not IsPunctuation(Str[i]) then
    begin
      Temp[j] := Str[i];
      Inc(j);
    end;

  if j = 0 then
    Exit(Default(ucs4));

  Result.Init(j);
  Move(Temp.FData^, Result.FData^, j * SizeOf(DWord));
  Temp.Clear;
end;

function TokenizeForNLP(const Str: ucs4): TUC4Array;
var
  i, Start, Count: Integer;
  InWord: Boolean;
begin
  if Str.Length = 0 then
    Exit(nil);

  // Первый проход - подсчет токенов
  Count := 0;
  InWord := False;
  for i := 0 to Str.Length - 1 do
  begin
    if IsWhiteSpace(Str[i]) or IsPunctuation(Str[i]) then
    begin
      if InWord then
      begin
        Inc(Count);
        InWord := False;
      end;
    end
    else
      InWord := True;
  end;
  if InWord then Inc(Count);

  SetLength(Result, Count);
  if Count = 0 then Exit;

  // Второй проход - заполнение токенов
  Count := 0;
  Start := 0;
  InWord := False;
  for i := 0 to Str.Length - 1 do
  begin
    if IsWhiteSpace(Str[i]) or IsPunctuation(Str[i]) then
    begin
      if InWord then
      begin
        Result[Count].Init(i - Start);
        Move(Str.FData[Start], Result[Count].FData^, (i - Start) * SizeOf(DWord));
        Inc(Count);
        InWord := False;
      end;
    end
    else if not InWord then
    begin
      Start := i;
      InWord := True;
    end;
  end;

  if InWord then
  begin
    Result[Count].Init(Str.Length - Start);
    Move(Str.FData[Start], Result[Count].FData^, (Str.Length - Start) * SizeOf(DWord));
  end;
end;

function Copy(const Str: ucs4; StartPos, Length: Integer): ucs4;
var
  ActualStart, ActualLength: Integer;
begin
  Result.Init;
  
  if Str.Length = 0 then Exit;
  
  // Обработка индексов (1-based)
  if StartPos < 1 then
    ActualStart := 0
  else if StartPos > Str.Length then
    Exit(Result) // Пустой результат
  else
    ActualStart := StartPos - 1;
  
  // Определение длины
  if Length <= 0 then Exit;
  
  if ActualStart + Length > Str.Length then
    ActualLength := Str.Length - ActualStart
  else
    ActualLength := Length;
  
  if ActualLength <= 0 then Exit;
  
  // Использование Move для копирования блоков памяти
  Result.Init(ActualLength);
  if ActualLength > 0 then
    Move(Str.FData[ActualStart], Result.FData^, ActualLength * SizeOf(DWord));
end;

function Copy(const Str: ucs4; StartPos: Integer): ucs4;
begin
  // Вызов полной версии с Length = MaxInt (до конца строки)
  Result := Copy(Str, StartPos, MaxInt);
end;

function Mid(const Str: ucs4; StartPos, Length: Integer): ucs4;
begin
  // Просто обертка вокруг Copy с корректировкой индекса
  Result := Copy(Str, StartPos + 1, Length);
end;

function Mid(const Str: ucs4; StartPos: Integer): ucs4;
begin
  Result := Copy(Str, StartPos + 1, MaxInt);
end;

function Left(const Str: ucs4; Count: Integer): ucs4;
begin
  if Count <= 0 then
    Exit(Default(ucs4));
  
  if Count > Str.Length then
    Count := Str.Length;
    
  Result := Copy(Str, 1, Count);
end;

function Right(const Str: ucs4; Count: Integer): ucs4;
var
  StartPos: Integer;
begin
  if Count <= 0 then
    Exit(Default(ucs4));
  
  if Count > Str.Length then
    Count := Str.Length;
    
  StartPos := Str.Length - Count + 1;
  Result := Copy(Str, StartPos, Count);
end;

end.