Question

How to group words in a string by the first N letters in Pascal

Answer 1

program GroupWordsProgram;

const
  MaxWords   = 512;
  MaxGroups  = 256;
  MaxWordLen = 64;

type
  WordStr = string[MaxWordLen];

  Group = record
    Prefix : WordStr;
    Words  : array[1..MaxWords] of WordStr;
    Count  : integer;
  end;

var
  Groups : array[1..MaxGroups] of Group;
  GroupCount : integer;

function LowerChar(c: char): char;
begin
  if (c >= 'A') and (c <= 'Z') then
    LowerChar := chr(ord(c) + 32)
  else
    LowerChar := c;
end;

function IsLetter(c: char): boolean;
begin
  IsLetter := ((c >= 'A') and (c <= 'Z')) or
              ((c >= 'a') and (c <= 'z'));
end;

function ToLower(const s: string): string;
var
  i: integer;
begin
  ToLower := s;
  for i := 1 to length(s) do
    ToLower[i] := LowerChar(s[i]);
end;

function FindOrCreateGroup(const prefix: string): integer;
var
  i: integer;
begin
  for i := 1 to GroupCount do
    if Groups[i].Prefix = prefix then
    begin
      FindOrCreateGroup := i;
      exit;
    end;

  inc(GroupCount);
  Groups[GroupCount].Prefix := prefix;
  Groups[GroupCount].Count := 0;

  FindOrCreateGroup := GroupCount;
end;

procedure AddWordToGroup(const prefix, word: string);
var
  idx: integer;
begin
  idx := FindOrCreateGroup(prefix);
  inc(Groups[idx].Count);
  Groups[idx].Words[Groups[idx].Count] := word;
end;

procedure GroupByFirstNLetters(const s: string; n: integer);
var
  i, start, len: integer;
  word, prefix: string;
begin
  i := 1;
  while i <= length(s) do
  begin
    while (i <= length(s)) and not IsLetter(s[i]) do
      inc(i);

    if i > length(s) then exit;

    start := i;
    while (i <= length(s)) and IsLetter(s[i]) do
      inc(i);

    len := i - start;
    if len >= n then
    begin
      word := ToLower(copy(s, start, len));
      prefix := copy(word, 1, n);
      AddWordToGroup(prefix, word);
    end;
  end;
end;

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

var
  text: string;

begin
  text := 'The lowly inhabitants of the lowland were surprised to see ' +
          'the lower branches of the trees.';

  GroupCount := 0;

  GroupByFirstNLetters(text, 3);
  PrintGroups;
end.




(*
run:

the: the the the the 
low: lowly lowland lower 
inh: inhabitants 
wer: were 
sur: surprised 
see: see 
bra: branches 
tre: trees 

*)

 

70+ SQL courses for beginners and professionals