Question

How to group Anagrams from an array of strings in Pascal

Answer 1

program GroupAnagramsFGL;

{$mode objfpc}{$H+}

uses
  SysUtils, Classes, fgl;

type
  TStringListList = specialize TFPGList<TStringList>;
  TStrMap = specialize TFPGMap<string, TStringList>;

function SortString(const S: string): string;
var
  chars: TStringList;
  i: Integer;
begin
  chars := TStringList.Create;
  try
    chars.CaseSensitive := True;
    for i := 1 to Length(S) do
      chars.Add(S[i]);
    chars.Sort;
    Result := chars.Text.Replace(#13, '').Replace(#10, ''); // Removes newlines
  finally
    chars.Free;
  end;
end;

procedure GroupAnagrams(const Input: array of string; Output: TStringListList);
var
  Map: TStrMap;
  i, idx: Integer;
  Key: string;
  Group: TStringList;
begin
  Map := TStrMap.Create;
  try
    for i := Low(Input) to High(Input) do
    begin
      Key := SortString(Input[i]);
      idx := Map.IndexOf(Key);
      if idx = -1 then
      begin
        Group := TStringList.Create;
        Map.Add(Key, Group);
      end
      else
        Group := Map.Data[idx];

      Group.Add(Input[i]);
    end;

    for i := 0 to Map.Count - 1 do
      Output.Add(Map.Data[i]);
  finally
    Map.Free; // Map frees its TStringList instances
  end;
end;

var
  Input: array[0..6] of string = ('eat', 'tea', 'tan', 'ate', 'nat', 'bat', 'tae');
  ResultGroups: TStringListList;
  Group: TStringList;
  s: string;
  i: Integer;
begin
  ResultGroups := TStringListList.Create;
  GroupAnagrams(Input, ResultGroups);

  for i := 0 to ResultGroups.Count - 1 do
  begin
    Group := ResultGroups[i];
    for s in Group do
      Write(s, ' ');
    Writeln();
  end;

  // Free all TStringList instances properly
  for i := 0 to ResultGroups.Count - 1 do
    ResultGroups[i].Free;
  
  ResultGroups.Free;
end.



(*
run:

eat tea ate tae 
tan nat 
bat 

*)

 

70+ SQL courses for beginners and professionals