Welcome to collectivesolver - Programming & Software Q&A with code examples. A website with trusted programming answers. All programs are tested and work.

Contact: aviboots(AT)netvision.net.il

Semrush - keyword research tool

Turn ChatGPT, Claude, Gemini, And CoPilot Into Your Personal Assistant, Business Coach, Content Creator, And More

AFFILIATE MARKETING Your all-in-one performance engine Manage affiliates, creators, and customer referrals in one unified platform—turning every partnership into measurable growth
Secure & Reliable Web Hosting, Free Domain, Free SSL, 1-Click WordPress Install, Expert 24/7 Support

Boost your online presence with premium web hosting and servers

Disclosure: My content contains affiliate links.

42,690 questions

55,449 answers

573 users

How to remove duplicate words from free‑text in Pascal

1 Answer

0 votes
program RemoveDuplicateWordsFreeText;

{$mode objfpc}{$H+}

{
  Removes duplicate words from free text:

  - Case-insensitive
  - Preserves original casing of first occurrence
  - Splits on ANY non-letter sequence
  - Preserves original order
  - Uses efficient lookup (hash table)
  - Uses only built-in Free Pascal units

  Notes:
    Free Pascal does not support Unicode regex classes like \p{L}.
    Therefore we manually split on non-letter characters using a simple scanner.
}

uses
  SysUtils, Classes, FGL;

type
  // Hash table for fast case-insensitive lookup
  TStringHash = specialize TFPGMapObject<string, TObject>;


// ------------------------------------------------------------
// Helper: Check if a character is a letter (A–Z, a–z)
// ------------------------------------------------------------
function IsLetter(c: Char): Boolean;
begin
  Result := c in ['A'..'Z', 'a'..'z'];
end;


// ------------------------------------------------------------
// Split free text into words by scanning and breaking on
// ANY non-letter character.
// ------------------------------------------------------------
procedure SplitIntoWords(const S: string; Words: TStrings);
var
  i: Integer;
  current: string;
begin
  current := '';

  for i := 1 to Length(S) do
  begin
    if IsLetter(S[i]) then
      current := current + S[i]
    else
    begin
      if current <> '' then
      begin
        Words.Add(current);
        current := '';
      end;
    end;
  end;

  // Add last word if any
  if current <> '' then
    Words.Add(current);
end;


// ------------------------------------------------------------
// Main function: remove duplicate words
// ------------------------------------------------------------
function RemoveDuplicateWordsFreeText(const Text: string): string;
var
  Words: TStringList;
  Unique: TStringList;
  Seen: TStringHash;
  i: Integer;
  Word, Key: string;
begin
  Words := TStringList.Create;
  Unique := TStringList.Create;
  Seen := TStringHash.Create;

  try
    // Split input into words
    SplitIntoWords(Trim(Text), Words);

    for i := 0 to Words.Count - 1 do
    begin
      Word := Words[i];

      // Case-insensitive key
      Key := LowerCase(Word);

      // Check if already seen
      if Seen.IndexOf(Key) = -1 then
      begin
        Seen.Add(Key, nil);
        Unique.Add(Word);   // preserve original casing
      end;
    end;

    // Reassemble into a space-separated string
    Result := Trim(Unique.Text.Replace(LineEnding, ' '));

  finally
    Words.Free;
    Unique.Free;
    Seen.Free;
  end;
end;


// ------------------------------------------------------------
// Program entry point
// ------------------------------------------------------------
var
  Input, Output: string;
begin
  Input :=
    'Hello, hello! This is a test. A TEST, hello universe...   ' +
    'UNIVERSE! Hello; ***  Is Anybody There?';

  Output := RemoveDuplicateWordsFreeText(Input);

  WriteLn(Output);
end.



(*
run:

Hello This is a test universe Anybody There

*)

 



answered Aug 2 by avibootz
...