Подсчитать кол-во одинаковых слов в Memo и вывести результат в переменную integer?

[FleXik]

Вобщем нужно подсчитать кол-во одинаковых слов в Memo и вывести результат в переменную integer? Слышал про функцию FindNext (или типа того), но как ее использовать? Или есть другой способ?

Пробовал

for i:=0 to Memo1.Lines.Count-1

и дальше проверка if Pos ,но, если в строке два одинаковых слова - if Pos не покатит...

[Аватар]

Кроме Pos есть еще PosEx
И просто такой способ в лоб не прокатит - в строке незабудка есть слово будка? В строке Дерево есть слово дерево?
Если разделитель слов только пробел можно просто обыкновенным TStringList разбить на слова и простенько искать. Если и другие разделители, то задача усложняется на порядок.
И есть еще куча подобных тем на форуме

[blackstrip]

Сначала из строки s надо сделать uppercase(' '+Trim(s)+' '), тогда все слова гарантированно будут иметь слева и справа от себя минимум 1 пробел. И искать не слово "дерево", а " ДЕРЕВО ". Тогда задача немного упростится.

[Serge_Bliznykov]

тоже же мне, бином Ньютона...

CountWordsInMemo.rar

CountWordsInMemo_EXE.rar

implementation

{$R *.dfm}
procedure FindWordInString(S:string; var TS : TStringList);
const
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var i:integer;
    S2:string;
begin
//  Result := TStringList.Create;
  S2 := '';
  For i:=1 to Length(S) do
  begin
     if (s[i] in D) then begin
        if (Length(S2)>0) then begin
          TS.Append(S2);
          S2:='';
        end;
     end
    else
        S2:=S2+s[i];
  end;
  if (Length(S2)>0) then TS.Append(S2);
end;

procedure TForm6.Button1Click(Sender: TObject);
var TS : TStringList;
  OneWord : string;
  i, cnt : integer;
begin
   TS := TStringList.Create;
   Memo2.Lines.Clear;
   try
     FindWordInString( Memo1.Lines.Text, TS );
     if TS.Count = 0 {список пуст - слов нет - Выходим} then begin
       Memo2.Lines.Append('Не найдено ни одного слова!');
     end;
     TS.Sort;
     // А вот собственно  и подсчёт
     OneWord := TS.Strings[0];
     Cnt := 1;
     for i := 1 to TS.Count - 1 do
       if AnsiUpperCase(TS.Strings[i]) = AnsiUpperCase(OneWord) then inc(Cnt)
       else begin
         Memo2.Lines.Append(OneWord+' '+InttoStr(Cnt));
         OneWord := TS.Strings[i];
         Cnt := 1;
       end;

     // для последнего слова в списке вывод результата
     Memo2.Lines.Append(OneWord+' '+InttoStr(Cnt));

   finally
     TS.Free;
   end;
end;

[FleXik]

Если разделитель слов только пробел можно просто обыкновенным TStringList разбить на слова и простенько искать.

так-то можно, вот только если опять же потом через if Pos делать то если ищем слово будка и в списке попадется слово незабудка то оно его засчитает

я конечно же нашел уже ответ, работает отлично, но, хотелось бы функцию...

[FleXik]

на сонную голову надумалось что решить проблему можно используя регулярку))) сколько не гуглил никто до этого не додумался...

Вобщем имеем это:

procedure TForm1.sButton1Click(Sender: TObject);
var
  RegExp:TRegExpr;
  i:integer;
begin
  i:=0;
  RegExp:=TRegExpr.Create;
  RegExp.Expression:='тест';

    if RegExp.Exec(Form1.sMemo.Text) then
    repeat
      i:=i+1;
    until not RegExp.ExecNext;

  ShowMessage(IntToStr(i));
  RegExp.Free;
end;

в отличии от цикла (описывал в предыдущих сообщениях в этой теме) даже если в строке два слова или больше - их засчитывает, но, если в Memo присутствуют слова "тестер", "тестинг" и им подобные - их тоже засчитывает, можно ли как-то настроить шаблон регулярки или переделать код чтобы искало суто слово "тест" ?

[Serge_Bliznykov]

надо косячок исправить в коде:

if TS.Count = 0 {список пуст - слов нет - Выходим} then begin
       Memo2.Lines.Append('Не найдено ни одного слова!');
       Exit;
     end;

а то в комментах написал "выходим", а команду на выход забыл написать...

p.s. это я к коду из поста #4

[FleXik]

решил траблу с помощью цикла к коду в сообщении #6, как именно решил - додумывайте сами, но, еще протестирую немного и отпишусь идеально ли все работает...

[Serge_Bliznykov]

если лежит душа к регулярке, то можно попробовать так:

 RegExp:=TRegExpr.Create;
  RegExp.Expression:='\Wтест\W';

    if RegExp.Exec(' '+Form1.sMemo.Text+' ') then
...

[FleXik]

if RegExp.Exec(' '+Form1.sMemo.Text+' ') then

я так и сделал, только в шаблоне тоже пробелы...