Extract string-token objects from string?

Question

Does Delphi (10.4) have a string-tokenizer that extracts string-token-objects from a string in a similar way as below?

MyPhrase := 'I have a simple word and a complex Word: A lot of WORDS.';

MyTokens := MyTokenize(MyPhrase, 'word');

for i := 0 to MyTokens.Count - 1 do
  Memo1.Lines.Add(IntToStr(MyTokens[i].Pos) + ': ' + MyTokens[i].String);

Gives this result in Memo1:

16: word  
35: Word  
50: WORD

Searching for "tokenize string" in the Delphi documentation did not get any useful results for this purpose.

Of course, writing such a function is trivial, but I wonder if there already is a procedure for this in the existing huge Delphi code treasure.

EDIT: I am experimenting with a wordlist that should have the required features:

program MyTokenize;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  CodeSiteLogging,
  System.RegularExpressions,
  System.Types,
  System.Classes,
  System.StrUtils,
  System.SysUtils;

type
  PWordRec = ^TWordRec;

  TWordRec = record
    WordStr: string;
    WordPos: Integer;
  end;

  TWordList = class(TList)
  private
    function Get(Index: Integer): PWordRec;
  public
    destructor Destroy; override;
    function Add(Value: PWordRec): Integer;
    property Items[Index: Integer]: PWordRec read Get; default;
  end;

function TWordList.Add(Value: PWordRec): Integer;
begin
  Result := inherited Add(Value);
end;

destructor TWordList.Destroy;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    FreeMem(Items[i]);
  inherited;
end;

function TWordList.Get(Index: Integer): PWordRec;
begin
  Result := PWordRec(inherited Get(Index));
end;

var
  WordList: TWordList;
  WordRec: PWordRec;
  i: Integer;

begin
  try
    //MyPhrase := 'A crossword contains words but not WORD';

    WordList := TWordList.Create;
    try
      // AV only at the THIRD loop!!!
      for i := 0 to 2 do
      begin
        GetMem(WordRec, SizeOf(TWordRec));
        WordRec.WordPos := i;
        WordRec.WordStr := IntToStr(i);
        WordList.Add(WordRec);
      end;

      for i := 0 to WordList.Count - 1 do
        Writeln('WordPos: ', WordList[i].WordPos, ' WordStr: ', WordList[i].WordStr);

      WriteLn('  Press Enter to free the list');
      ReadLn;
    finally
      WordList.Free;
    end;

  except
    on E: Exception do
    begin
      Writeln(E.ClassName, ': ', E.Message);
      ReadLn;
    end;
  end;
end.

Unfortunately, it has a strange bug: It gets an AV exactly at the THIRD for loop!

EDIT2: It seems that the AV happens only when the project's Build Configuration is set to Debug. When the project's Build Configuration is set to Release then there is no AV. Has this to do with the MemoryManager?

Answer 1

On request, here is how I would do this myself:

First, I want to create a function that performs this operation, so it can be reused every time we need to do this.

I could have this function return or populate a TList<TWordRec>, but then it would be tiresome to work with it, because the user of the function would then need to add try..finally blocks every time the function is used. Instead, I let it return a TArray<TWordRec>. By definition, this is simply array of TWordRec, that is, a dynamic array of TWordRecs.

But how to efficiently populate such an array? We all know you shouldn't increase the length of a dynamic array one element at a time; besides, that requires a lot of code. Instead, I populate a local TList<TWordRec> and then, as a last step, create an array from it:

type
  TPhraseMatch = record
    Position: Integer;
    Text: string;
  end;

function GetPhraseMatches(const AText, APhrase: string): TArray<TPhraseMatch>;
begin

  var TextLower := AText.ToLower;
  var PhraseLower := APhrase.ToLower;

  var List := TList<TPhraseMatch>.Create;
  try

    var p := 0;
    repeat
      p := Pos(PhraseLower, TextLower, p + 1);
      if p <> 0 then
      begin
        var Match: TPhraseMatch;
        Match.Position := p - 1 {since the OP wants 0-based string indexing};
        Match.Text := Copy(AText, p, APhrase.Length);
        List.Add(Match);
      end;
    until p = 0;

    Result := List.ToArray;

  finally
    List.Free;
  end;

end;

Notice that I chose an alternative to the regular expression approach, just for educational reasons. I also believe this approach is faster. Also notice how easy it is to work with the TList<TWordRec>: it's just like a TStringList but with word records instead of strings!

Now, let's use this function:

procedure TWordFinderForm.ePhraseChange(Sender: TObject);
begin

  lbMatches.Items.BeginUpdate;
  try
    lbMatches.Items.Clear;
    for var Match in GetPhraseMatches(mText.Text, ePhrase.Text) do
      lbMatches.Items.Add(Match.Position.ToString + ':'#32 + Match.Text)
  finally
    lbMatches.Items.EndUpdate;
  end;

end;

Had I not chosen to use a function, but placed all code in one block, I could have iterated over the TList<TWordRec> in exactly the same way:

for var Match in List do

Answer 2

Largely for my own amusement, I decided to write an answer which tokenizes the input in the same way Delphi's compiler does. This is shown below.

Of course, the OP's requirement that the code should match the 'WORD' in 'WORDS' precludes a direct comparison between the Target string and Parser.TokenString and necessitates the derivation of Fragment as written.

It shows, btw, that the use of constructs such a PWordRec and manual allocation and de-allocation of the 'tokens' are not necessary.

    program StringTokens;

    {$APPTYPE CONSOLE}

    {$R *.res}

    uses
      System.SysUtils, System.Classes;

    var
      Parser : TParser;
      MyPhrase : String;
      Target : String;
      Fragment : String;
      SS : TStringStream;
      List : TStringList;
      i : Integer;
    begin

      MyPhrase := 'I have a simple word and a complex Word: A lot of WORDS. A partial wor';
      Target := 'word';
      SS := TStringStream.Create(MyPhrase);
      List := TStringlist.Create;
      Parser := TParser.Create(SS);

      try
        while Parser.Token <> #0 do begin
          Fragment := Copy(Parser.TokenString, 1, Length(Target));
          if SameText(Fragment, Target) then
            List.Add(Fragment);
          Parser.NextToken;
        end;

        for i := 0 to List.Count - 1 do
          writeln(i, List[i]);
        readln;
      finally
        List.Free;
        Parser.Free;
        SS.Free;
      end;
    end.

Update:

In case it isn't obvious, it's trivial to obtain the positions in the source string where the token fragments occur, as follows

    [...]
    if SameText(Fragment, Target) then
      List.AddObject(Fragment, TObject(Parser.SourcePos));

    [...]
    for i := 0 to List.Count - 1 do
      writeln(i, List[i], integer(List.Objects[i]));

Answer 3

This gives the result as required in the question:

EDIT: I have now simplified the code by using WordRec.WordPos := MatchResult.Index;

EDIT2: Cleaned up the uses list

program MyTokenize;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.RegularExpressions,
  System.Classes,
  System.SysUtils;

type
  PWordRec = ^TWordRec;

  TWordRec = record
    WordStr: string;
    WordPos: Integer;
  end;

  TWordList = class(TList)
  private
    function Get(Index: Integer): PWordRec;
  public
    destructor Destroy; override;
    function Add(Value: PWordRec): Integer;
    property Items[Index: Integer]: PWordRec read Get; default;
  end;

function TWordList.Add(Value: PWordRec): Integer;
begin
  Result := inherited Add(Value);
end;

destructor TWordList.Destroy;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
  begin
    System.Dispose(Items[i]);
  end;
  inherited;
end;

function TWordList.Get(Index: Integer): PWordRec;
begin
  Result := PWordRec(inherited Get(Index));
end;

var
  WordList: TWordList;
  WordRec: PWordRec;
  i: Integer;
  RegexObj: TRegEx;
  MatchResult: TMatch;
  MyPhrase, MyWord: string;

begin
  try
    MyPhrase := 'A crossword contains words but not WORD';
    MyWord := 'word';

    WordList := TWordList.Create;
    try
      RegexObj := TRegEx.Create(MyWord, [roIgnoreCase]);
      MatchResult := RegexObj.Match(MyPhrase);
      while MatchResult.Success do
      begin
        WordRec := System.New(PWordRec);
        WordRec.WordPos := MatchResult.Index;
        WordRec.WordStr := MatchResult.Value;
        WordList.Add(WordRec);
        MatchResult := MatchResult.NextMatch;
      end;

      // Output:
      for i := 0 to WordList.Count - 1 do
        Writeln('WordPos: ', WordList[i].WordPos, ' WordStr: ', WordList[i].WordStr);

      WriteLn('  Press Enter to free the list');
      ReadLn;
    finally
      WordList.Free;
    end;

  except
    on E: Exception do
    begin
      Writeln(E.ClassName, ': ', E.Message);
      ReadLn;
    end;
  end;
end.