Количество одинаковых слов в строке. Delphi

[topside]

Требуется написать программу, которая выводит слова, встречающиеся более одного раза и пишет количество повторов. Так происходит для каждого слова. Вот мой код, но я видимо как-то не так организовал поиск равных элементов, подскажите пожалуйста как надо. Или может есть вообще другой вариант, без доп. массивов? Количество пробелов между словами - любое.

program Words;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  S: string;
  A: array of string;
  B: array of Integer;
  I, J, K: Integer;
  Rez, Kol: Integer;

begin
  WriteLn('Введите строку');
  ReadLn(S);

  I := 1;
  while S[1] = ' ' do
    Delete(S, 1, 1);
  while I <= Length(S) do
  begin
    if S[I] = ' ' then
    while (S[I+1] = ' ') and (Length(S) >= I) do
      Delete(S, I, 1);
    Inc(I);
  end;
  WriteLn(S);

  S := ' ' + S;
  K := 0;
  SetLength(A, 1);
  for I := 1 to Length(S) do
    if S[I] = ' ' then
      Inc(K)
    else
      begin
        SetLength(A, Length(A)+1);
        A[K] := A[K] + S[I];
      end;

  SetLength(B, 1);
  for I := 1 to High(A)-1 do
    for J := I+1 to High(A) do
      if A[I] = A[J] then
      begin
        SetLength(B, Length(B)+1);
        Inc(B[I]);
      end;
  for I := 1 to High(A) do
    Write(A[I], '  ', B[I]);   


  ReadLn;
  end.

[topside]

Попробовал сделать без массива, сохраняя слово а затем удаляя его, но не знаю как организовать теперь его сравнение с последующими словами.

[alex_sed]

var
  S, S_: String;
  n, k, m: Integer;
begin
  WriteLn('Введтите строку: ');
  ReadLn(S);
  repeat
    S:=Trim(S); // Удаляем лишние пробелы
    m:=0;
    n:=Pos(' ', S);
    if n>0 then S_:=Copy(S, 1, n-1) else S_:=S;
    repeat
      k:=Pos(S_, S);
      if k>0 then
        begin
          S:=Copy(S, 1, k-1)+Copy(S, k+Length(S_), Length(S)); // Выкусываем слово
          inc(m);
        end;
    until k=0;
    WriteLn(S_, '  ', m);
  until S='';
  ReadLn;
end.

________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[topside]

Благодарствую.

[Serge_Bliznykov]

topside

просто для информации.
Раз обработка строки идёт в Delphi, то можно привлечь имеющиеся компоненты. Например, TStringList.
посмотрите варианты решения в темах:
1) повторение слов в txt файле
2) Статистика слов в тексте

[alex_sed]

Сообщение от Serge_Bliznykov

topside

просто для информации.
Раз обработка строки идёт в Delphi, то можно привлечь имеющиеся компоненты. Например, TStringList.
посмотрите варианты решения в темах:
1) повторение слов в txt файле
2) Статистика слов в тексте

В данных примерах с текстом ошибка, при переходе у следующему слову и оно уже до этого было, будет снова добавляться в список для подсчета....
Вот по этому это не самый лучший вариант....

[Serge_Bliznykov]

Сообщение от alex_sed

В данных примерах с текстом ошибка, при переходе у следующему слову и оно уже до этого было, будет снова добавляться в список для подсчета....
Вот по этому это не самый лучший вариант....

alex_sed, не понял. что Вы имеете в виду?!
Конкретизируйте свои замечания, пример строки и результат "неправильной работы" приведите, пожалуйста.

Добавлено
ну, и ещё, запустил я Ваш код.
в принципе, код рабочий. но есть одна весьма нехорошая ошибка.
введите такой текст:
ты тыты ты тытышь тышь
уже догадываетесь, какой результат выдаст Ваша программа?
ну, а такой текст ещё нагляднее:
a aa aaa aa aaa aa

[alex_sed]

Нет, все нормально считает, не учел что TStringList сортируется.
Единственное, удалять TS вконце надо так TS.Free

[Serge_Bliznykov]

Единственное, удалять TS вконце надо так TS.Free

Вы невнимательно прочитали код...

в данных примерах в конце вызывается процедура FreeAndNil

FreeAndNil(TS);

она выполняет последовательно две операции. вызывает метод .Free для заданного объекта, а потом присваивает указателю на этот объект пустую ссылку.
т.е. FreeAndNil(TS) эквивалентно такому коду:

 TS.Free; TS := nil;

[alex_sed]

Исправляю, теперь различает...

var
  S, S_: String;
  n, k, m: Integer;
begin
  WriteLn('Введите строку: ');
  ReadLn(S);
  repeat
    S:=Trim(S); // Удаляем лишние пробелы
    m:=0;
    n:=Pos(' ', S);
    if n>0 then S_:=Copy(S, 1, n-1) else S_:=S;
    repeat
      k:=Pos(S_+' ', S+' ');
      if k>0 then
        begin
          S:=Copy(S, 1, k-1)+Copy(S, k+Length(S_), Length(S)); // Выкусываем слово
          inc(m);
        end;
    until k=0;
    if S_<>'' then WriteLn(S_, '  ', m);
  until S='';
  ReadLn;
end.