从字符串中提取字符串标记对象？
Extract string-token objects from string?
Delphi (10.4) 是否有一个字符串分词器，它以类似于下面的方式从字符串中提取字符串分词对象？
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: AV 似乎只有在项目的构建配置设置为 Debug 时才会发生。当项目的构建配置设置为 Release 时，则没有 AV。这与内存管理器有关吗？
这给出了问题中要求的结果：
编辑： 我现在使用 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.
主要是为了自娱自乐，我决定写一个答案
以与 Delphi 的编译器相同的方式标记输入。如下所示。
当然，OP 要求代码应与 'WORD'
in 'WORDS' 排除了目标字符串之间的直接比较
和 Parser.TokenString 并且需要推导所写的 Fragment。
它表明，顺便说一句，不需要使用 PWordRec 等构造以及 'tokens' 的手动分配和取消分配。
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.
更新：
如果不是很明显，获取源字符串中的位置是微不足道的
token碎片出现的地方，如下
[...]
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]));
应要求，以下是我自己的做法：
首先，我想创建一个执行此操作的函数，以便我们每次需要执行此操作时都可以重复使用它。
我可以拥有这个函数 return 或填充一个 TList<TWordRec>，但是使用它会很烦人，因为函数的用户随后需要添加 try..finally 每次使用函数时都会阻塞。相反，我让它 return 一个 TArray<TWordRec>。根据定义，这只是 array of TWordRec，即 TWordRec 的动态数组。
但是如何高效地填充这样一个数组呢？我们都知道你不应该一次增加一个动态数组的长度。此外，这需要大量代码。相反，我填充一个本地 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
Delphi (10.4) 是否有一个字符串分词器，它以类似于下面的方式从字符串中提取字符串分词对象？
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: AV 似乎只有在项目的构建配置设置为 Debug 时才会发生。当项目的构建配置设置为 Release 时，则没有 AV。这与内存管理器有关吗？
这给出了问题中要求的结果：
编辑： 我现在使用 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.
主要是为了自娱自乐，我决定写一个答案 以与 Delphi 的编译器相同的方式标记输入。如下所示。
当然，OP 要求代码应与 'WORD' in 'WORDS' 排除了目标字符串之间的直接比较 和 Parser.TokenString 并且需要推导所写的 Fragment。
它表明，顺便说一句，不需要使用 PWordRec 等构造以及 'tokens' 的手动分配和取消分配。
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.
更新：
如果不是很明显，获取源字符串中的位置是微不足道的 token碎片出现的地方，如下
[...]
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]));
应要求，以下是我自己的做法：
首先，我想创建一个执行此操作的函数，以便我们每次需要执行此操作时都可以重复使用它。
我可以拥有这个函数 return 或填充一个 TList<TWordRec>，但是使用它会很烦人，因为函数的用户随后需要添加 try..finally 每次使用函数时都会阻塞。相反，我让它 return 一个 TArray<TWordRec>。根据定义，这只是 array of TWordRec，即 TWordRec 的动态数组。
但是如何高效地填充这样一个数组呢？我们都知道你不应该一次增加一个动态数组的长度。此外，这需要大量代码。相反，我填充一个本地 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