从字符串中提取字符串标记对象？答案

【问题标题】：Extract string-token objects from string?从字符串中提取字符串标记对象？
【发布时间】：2021-05-22 17:41:30
【问题描述】：

Delphi (10.4) 是否有一个 string-tokenizer，可以以类似于下面的方式从字符串中提取 string-token-objects？

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);

在 Memo1 中给出这个结果：

16: word  
35: Word  
50: WORD

在 Delphi 文档中搜索“tokenize string”并没有得到任何有用的结果。

当然，写这样一个函数是小菜一碟，但不知道现有庞大的Delphi代码宝库中是否已经有这个程序。

编辑：我正在试验一个应该具有所需功能的单词表：

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.

不幸的是，它有一个奇怪的错误：它恰好在第三个 for 循环中获得了一个 AV！

EDIT2：似乎只有在项目的构建配置设置为Debug 时才会发生 AV。当项目的 Build Configuration 设置为 Release 时，就没有 AV。这和 MemoryManager 有关系吗？

【问题讨论】：

@user1580348：请注意我没有投反对票。根据我对 SO 社区的了解，我只是在猜测其他人为什么这样做。无需杀死信使。
我同意，这是一个有效的问题。只是说这种解释对每个人来说可能并不明显。但是有了你在这里的评论，它确实变得很明显。您可能希望在下次 Q 中包含“当然，编写这样的函数是微不足道的，但我想知道 Delphi RTL 中是否已经有一个标准工具”或类似的东西。关于“填字游戏”，我可能会警告您，有数学倾向的人不会认为示例可以替代精确的说明。
“从我的例子中，很明显它应该产生 (14, word)” 我的理解正好相反。
在通常的规则下，分词会将“填字游戏”视为单个词，因此无法匹配“单词”。在这里使用术语“令牌”是不正确的。看来您要做的就是在字符串中查找子字符串的出现（以不区分大小写的方式）。
代码中发生的情况是，在GetMem 之后，WordRec 指向内存中新分配的SizeOf(TWordRec) 大小的区域。由于GetMem 没有用零填充这个块，WordRec.WordStr 将是一个随机指针。因此，当您执行WordRec.WordStr := '...' 时，RTL 将转到内存中的这个随机位置，认为它是一个字符串堆对象，并将其“引用计数”减少 1。换句话说，它将进行“随机”更改到内存中的“随机”位置。那么任何事情都可能发生。希望是 AV。

标签： string delphi tokenize delphi-10.4-sydney

【解决方案1】：

根据要求，我自己会这样做：

首先，我想创建一个执行此操作的函数，以便我们每次需要执行此操作时都可以重用它。

我可以让这个函数返回或填充TList<TWordRec>，但是使用它会很烦人，因为该函数的用户需要在每次使用该函数时添加try..finally 块。相反，我让它返回一个TArray<TWordRec>。根据定义，这就是array of TWordRec，即TWordRecs的动态数组。

但是如何有效地填充这样的数组呢？我们都知道你不应该一次增加一个动态数组的长度；此外，这需要大量代码。相反，我填充了一个本地 TList<TWordRec>，然后，作为最后一步，从中创建一个数组：

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;

请注意，出于教育原因，我选择了正则表达式方法的替代方法。我也相信这种方法更快。还要注意使用TList<TWordRec> 是多么容易：它就像TStringList，但使用的是单词记录而不是字符串！

现在，让我们使用这个函数：

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;

如果我没有选择使用函数，而是将所有代码放在一个块中，我可以以完全相同的方式迭代 TList<TWordRec>：

for var Match in List do

【讨论】：

根据具体规范，您可能希望在 p + APhrase.Length 开始下一次搜索。尝试在wwwwww 中搜索w 以查看差异。
非常好的高级代码！我已在 Delphi 10.4.1 中将其重建为 Windows 32 VCL 应用程序。使用此代码的最低 Delphi 版本是哪个？
谢谢！我制作的示例应用程序（屏幕截图）也是一个 32 位 VCL Windows 应用程序。（我从不接触任何其他平台或 FMX！）代码使用泛型，如果我没记错的话，它是在 Delphi 2009 中引入的。它还使用记录助手（例如：MyString.Length 而不是 Length(MyString) 和 MyString.ToUpper 而不是 AnsiUpperCase(MyString)。我不记得这些是什么时候添加的（XE3？）。最后，如您所见，我使用内联变量声明，我认为是在 Delphi 10.3 中添加的。所以你需要 10.3，但是通过非常小的更改，你可以让它在 Delphi 2009 中工作。
所以当用户有旧的 Delphi 版本时，他们可以使用下面我的解决方案。
啊，我忘了：你用的是正则表达式。这也是一个相当新的添加（XE？），所以使用旧版本的人需要使用我的基于 Pos 的方法。

【解决方案2】：

主要是为了我自己的消遣，我决定写一个答案以与 Delphi 的编译器相同的方式标记输入。如下所示。

当然，OP 要求代码应与“WORD”匹配 in 'WORDS' 排除目标字符串之间的直接比较和 Parser.TokenString 并且需要按照所写的方式派生 Fragment。

顺便说一句，它表明不需要使用诸如 PWordRec 之类的构造以及手动分配和取消分配“令牌”。

    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.

更新：

如果不明显，获取源字符串中的位置很简单令牌碎片出现的地方，如下

    [...]
    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]));

【讨论】：

您的代码不符合 OP 问题的主要要求。
在什么方面？
它没有给出词的位置。
当然不是，因为在适当的解析器输出的上下文中，它会去除空格等，源流中位置的概念是没有意义的。如果你想添加一个“tokennumber”，你可以添加一个正在运行的令牌计数器并使用 List.AddObject(Fragment, TObject(TokenNumber)) 来记录它。
显然，您没有理解 OP 的问题。请反复阅读，直到您理解为止。

【解决方案3】：

这给出了问题中要求的结果：

编辑：我现在使用WordRec.WordPos := MatchResult.Index;简化了代码

EDIT2：清理了uses列表

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.

【讨论】：

请注意，您必须使用Dispose。如果您使用FreeMem，您将泄漏长字符串堆对象，您可以查看是否启用了内存泄漏报告 (ReportMemoryLeaksOnShutdown := True)。（当然，今天使用TList<TWordRec> 是一个更好的主意。然后您需要no 样板代码并获得保证的类型安全和内存安全，并且您不需要泛型知识，因为一个概念。）
谢谢，我留下评论是对自己的警告。现在它被删除了。
谢谢！我对泛型的评论主要是针对从谷歌来到这个页面的其他人。
@AndreasRejbrand 如果您使用您提出的泛型解决方案从我的解决方案创建解决方案，那么我将接受它作为主要解决方案。
我写了一个答案，告诉你我将如何解决这个任务。基本上，这是您的解决方案，但为了方便起见，将通用列表和非正则表达式搜索方法打包到返回动态数组的函数中。