Question

How to convert an array of strings and group all the anagrams into subarrays in Pascal

Answer 1

program GroupAnagrams;

const
  MaxWords = 50;
  MaxLen   = 20;

type
  TString = string[MaxLen];

  TGroup = record
    Words : array[1..MaxWords] of TString;
    Count : integer;
    Key   : TString;
  end;

var
  Groups : array[1..MaxWords] of TGroup;
  GroupCount : integer;

procedure SortString(var s: TString);
var
  i, j : integer;
  temp : char;
begin
  for i := 1 to length(s) - 1 do
    for j := i + 1 to length(s) do
      if s[i] > s[j] then
      begin
        temp := s[i];
        s[i] := s[j];
        s[j] := temp;
      end;
end;

function FindGroupKey(key: TString): integer;
var
  i: integer;
begin
  FindGroupKey := -1;
  for i := 1 to GroupCount do
    if Groups[i].Key = key then
    begin
      FindGroupKey := i;
      exit;
    end;
end;

procedure AddWord(word: TString);
var
  sorted: TString;
  idx: integer;
begin
  sorted := word;
  SortString(sorted);

  idx := FindGroupKey(sorted);
  if idx = -1 then
  begin
    inc(GroupCount);
    Groups[GroupCount].Count := 0;
    Groups[GroupCount].Key := sorted;
    idx := GroupCount;
  end;

  inc(Groups[idx].Count);
  Groups[idx].Words[Groups[idx].Count] := word;
end;

procedure PrintGroups;
var
  i, j: integer;
begin
  writeln('[');
  for i := 1 to GroupCount do
  begin
    write('  [ ');
    for j := 1 to Groups[i].Count do
    begin
      write('''', Groups[i].Words[j], '''');
      if j < Groups[i].Count then
        write(', ');
    end;
    writeln(' ]');
  end;
  writeln(']');
end;

var
  arr: array[1..9] of TString = ('eat','tea','rop','ate','nat','orp','tan','bat','pro');
  i: integer;

begin
  GroupCount := 0;

  for i := 1 to 9 do
    AddWord(arr[i]);

  PrintGroups;

  readln;
end.




(*
run:

[
  [ 'eat', 'tea', 'ate' ]
  [ 'rop', 'orp', 'pro' ]
  [ 'nat', 'tan' ]
  [ 'bat' ]
]

*)

70+ SQL courses for beginners and professionals