Question

How to find the longest shared prefix among all words in a string with Pascal

Answer 1

program LongestSharedPrefixProgram;

const
  MaxWords   = 256;
  MaxLen     = 64;

type
  TStringArray = array[1..MaxWords] of string;
  TPrefixList  = array[1..MaxWords] of string;
  TCountList   = array[1..MaxWords] of integer;

var
  Words       : TStringArray;
  Prefixes    : TPrefixList;
  PrefixCount : TCountList;
  WordCount,
  PrefixTotal : integer;
  S           : string;


{---------------------------------------------------------------}
{ Extract alphabetic words from a string                        }
{---------------------------------------------------------------}
procedure ExtractWords(const S: string; var Arr: TStringArray; var Count: integer);
var
  i : integer;
  w : string;
begin
  Count := 0;
  w := '';

  for i := 1 to Length(S) do
  begin
    if UpCase(S[i]) in ['A'..'Z'] then
      w := w + LowerCase(S[i])
    else if w <> '' then
    begin
      Inc(Count);
      Arr[Count] := w;
      w := '';
    end;
  end;

  if w <> '' then
  begin
    Inc(Count);
    Arr[Count] := w;
  end;
end;


{---------------------------------------------------------------}
{ Add a prefix to the prefix table or increment its count       }
{---------------------------------------------------------------}
procedure AddPrefix(const P: string);
var
  i: integer;
begin
  for i := 1 to PrefixTotal do
    if Prefixes[i] = P then
    begin
      Inc(PrefixCount[i]);
      Exit;
    end;

  Inc(PrefixTotal);
  Prefixes[PrefixTotal] := P;
  PrefixCount[PrefixTotal] := 1;
end;


{---------------------------------------------------------------}
{ Build all prefixes for all words                              }
{---------------------------------------------------------------}
procedure BuildPrefixGroups;
var
  i, j: integer;
  P: string;
begin
  PrefixTotal := 0;

  for i := 1 to WordCount do
    for j := 1 to Length(Words[i]) do
    begin
      P := Copy(Words[i], 1, j);
      AddPrefix(P);
    end;
end;


{---------------------------------------------------------------}
{ Find the longest prefix that appears in 2+ words              }
{---------------------------------------------------------------}
function FindLongestSharedPrefix: string;
var
  i: integer;
  Best: string;
begin
  Best := '';

  for i := 1 to PrefixTotal do
    if (PrefixCount[i] >= 2) and (Length(Prefixes[i]) > Length(Best)) then
      Best := Prefixes[i];

  FindLongestSharedPrefix := Best;
end;


{---------------------------------------------------------------}
{ Main Program                                                  }
{---------------------------------------------------------------}
begin
  S := 'The Lowly inhabitants of the lowland were surprised to see the lower branches of the trees.';

  ExtractWords(S, Words, WordCount);
  BuildPrefixGroups;

  S := FindLongestSharedPrefix;

  if S <> '' then
  begin
    WriteLn('Longest shared prefix: ', S);
    WriteLn('prefix_len=', Length(S));
  end
  else
    WriteLn('No shared prefix found.');
end.




(*
run:

Longest shared prefix: lowl
prefix_len=4

*)

 

70+ SQL courses for beginners and professionals