Question

How to remove duplicate words with Unicode characters from free‑text in Pascal

Answer 1

{$mode objfpc}{$H+}
{$codepage UTF8}

program DedupUnicodeWords;

{ ------------------------------------------------------------------------
  DedupWords
  ----------
  Removes duplicate words from a piece of free (Unicode) text, ignoring
  punctuation and letter case, while keeping:
    - the ORIGINAL spelling/casing of the first occurrence of each word,
    - the ORIGINAL word order.

  Design / algorithm
  -------------------
  1. TOKENIZE  : walk the UTF-16 UnicodeString once, classifying every
                 character with TCharacter.IsLetterOrDigit (Unicode-aware,
                 so Latin, CJK, Greek, diacritics, digits etc. are all
                 handled correctly). Maximal runs of "word characters"
                 become tokens; everything else (spaces, commas, "!",
                 "*", ";", ...) is treated as a separator and discarded.

  2. FOLD CASE : build a case-folded key for every token by upper-casing
                 it character-by-character with TCharacter.ToUpper. This
                 correctly folds "Hello" / "hello" / "HELLO" to the same
                 key while leaving case-less scripts (Japanese, etc.)
                 untouched.

  3. DEDUPLICATE : use a specialized TDictionary<UnicodeString,Boolean> as
                 a hash set of folded keys already seen. Each token needs
                 exactly one hashed lookup + (possibly) one insert, both
                 O(1) amortised, so the whole pass is O(n) in the length
                 of the text - no nested loops, no O(n^2) comparisons.

  Overall complexity: O(n) time, O(u) extra space, where n = text length
  and u = number of distinct words.

  Note on FPC generics: in $mode objfpc (unlike Delphi mode), every
  generic instantiation must be prefixed with the "specialize" keyword,
  both in type declarations and in the "uses"-visible constructor calls.
  ------------------------------------------------------------------------ }

uses
  SysUtils, Character, Generics.Collections;

type
  { Explicit specializations, declared once and reused everywhere.
    This is the idiomatic FPC way to avoid repeating "specialize ..."
    all over the code and to keep type names readable. }
  TUnicodeStringArray = specialize TArray<UnicodeString>;
  TUnicodeStringList  = specialize TList<UnicodeString>;
  TSeenWordsSet        = specialize TDictionary<UnicodeString, Boolean>;

{ Returns True if C should be considered part of a word.
  TCharacter.IsLetterOrDigit is fully Unicode-aware. }
function IsWordChar(const C: UnicodeChar): Boolean; inline;
begin
  Result := TCharacter.IsLetterOrDigit(C);
end;

{ Case-folds a whole UnicodeString for comparison purposes, by upper-
  casing every character individually (works uniformly across scripts
  that have case - Latin, Greek, Cyrillic... - and is a no-op for
  scripts that don't, e.g. CJK). }
function FoldCase(const S: UnicodeString): UnicodeString;
var
  I: Integer;
begin
  SetLength(Result, Length(S));
  for I := 1 to Length(S) do
    Result[I] := TCharacter.ToUpper(S[I]);
end;

{ Splits Text into word tokens (runs of word characters), discarding
  every separator (punctuation, whitespace, symbols). Order and original
  casing of each token are preserved. }
function Tokenize(const Text: UnicodeString): TUnicodeStringArray;
var
  Words: TUnicodeStringList;
  I, Start, Len: Integer;
begin
  Words := TUnicodeStringList.Create;
  try
    I := 1;
    Len := Length(Text);
    while I <= Len do
    begin
      if IsWordChar(Text[I]) then
      begin
        Start := I;
        while (I <= Len) and IsWordChar(Text[I]) do
          Inc(I);
        Words.Add(Copy(Text, Start, I - Start));
      end
      else
        Inc(I);
    end;
    Result := Words.ToArray;
  finally
    Words.Free;
  end;
end;

{ Removes duplicate words from Text (case-insensitive, punctuation
  ignored), keeping the first occurrence's original spelling and the
  original word order. Words in the result are separated by a single
  space. }
function DeduplicateWords(const Text: UnicodeString): UnicodeString;
var
  Words: TUnicodeStringArray;
  Seen: TSeenWordsSet;
  W, Key: UnicodeString;
  FirstWord: Boolean;
begin
  Words := Tokenize(Text);
  Seen := TSeenWordsSet.Create;
  try
    Result := '';
    FirstWord := True;
    for W in Words do
    begin
      Key := FoldCase(W);
      if not Seen.ContainsKey(Key) then
      begin
        Seen.Add(Key, True);
        if not FirstWord then
          Result := Result + ' ';
        Result := Result + W;
        FirstWord := False;
      end;
    end;
  finally
    Seen.Free;
  end;
end;

var
  Input, Output: UnicodeString;

begin
  Input := 'Hello! こんにちは, ,hello こんにちは Bună ziua; Γεια σας Bună ziua *HELLO* Γεια σας';
  Output := DeduplicateWords(Input);

  { Convert explicitly to UTF-8 for console output, regardless of the
    terminal's default RawByteString codepage assumptions. }
  WriteLn(UTF8Encode(Output));
end.



(*
run:

Hello こんにちは Bună ziua Γεια σας

*)

 

70+ SQL courses for beginners and professionals