Pascal строки

[excel]

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

Вводится строка. Слова в строке отделяются пробелом или запятой. Определить какое слово в строке встречается чаще всего

 

[AZbest]

Спойлер

var
s, subs, s_max: string;
i, count_max, count_cur, d: Byte;
begin
count_max := 0;
s_max := '';
readln(s);
i := 1;
while (s[1]=' ')or(s[1]=',') do delete(s,1,1);
while (s[length(s)]=' ')or(s[length(s)]=',') do delete(s,length(s),1);
while(length(s)<>0) do
begin
i := 1;
while (s<>',')and(s<>' ')and(i<=length(s)) do inc(i);
count_cur := 0;
subs := copy(s,1,i-1);
d := Pos(subs,s);
d := Pos(subs,s);
d := Pos(subs,s)+length(subs)-1;

while
(Pos(subs,s)<>0)and(length(s)<>0)and
((s[Pos(subs,s)-1]=' ')or(s[Pos(subs,s)-1]=',')or(Pos(subs,s)=1))and
((Pos(subs,s)+length(subs)-1=length(s))or(s[Pos(subs,s)+length(subs)]=' ')or(s[Pos(subs,s)+length(subs)]=','))
do begin
delete(s,Pos(subs,s),length(subs));
inc(count_cur);
end;
while (length(s)<>0)and((s[1]=' ')or(s[1]=',')) do delete(s,1,1);
while (length(s)<>0)and((s[length(s)]=' ')or(s[length(s)]=',')) do delete(s,length(s),1);
if count_cur > count_max then
begin
count_max := count_cur;
s_max := subs;
end;
end;
writeln(subs,' ~ ',count_max);
readln;
end.

 

[yaski]

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

на делфи

Спойлер

type
  //Сведения о слове.
  TWord = record
    SWord : String; //Слово.
    Cnt : Integer; //Сколько раз слово встречается в тексте.
  end;
//Возвращает строку, содержащую список слов, которые в исходном
//тексте присутствуют наиболее часто.
function ProcStr(const aStr : String) : String;
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  //Величина приращения длины динамического массива.
  Capacity = 10;
var
  Arr : array of TWord; //Массив уникальных слов.
  SWord : String;
  i, j, Len, LenW, Cnt, CntMax : Integer;
begin
  Result := '';
  //Извлекаем слова и добавляем их в массив.
  Len := Length(aStr); //Длина строки.
  LenW := 0; //Длина очередного слова.
  Cnt := 0; //Количество значимых элементов в массиве.
  CntMax := 0; //Наибольшее количество присутствий слова в массиве.
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if aStr[i] in D then Continue;
    //Учитываем символ в длине слова.
    Inc(LenW);
    //Отслеживаем конец слова.
    if (i = Len) or (aStr[i + 1] in D) then begin
      //Получаем очередное слово из текста. Буквы слова делаем заглавными.
      SWord := AnsiUpperCase( Copy(aStr, i - LenW + 1, LenW) );
      //Ищем слово в массиве.
      j := 0;
      while j < Cnt do begin
        //Если слово обнаружено в массиве.
        if Arr[j].SWord = SWord then begin
          //Увеличиваем счётчик данного слова на 1.
          Inc(Arr[j].Cnt);
          Break;
        end;
        //Переход к следующему элементу массива.
        Inc(j);
      end;
      //Если j = Cnt, то слова нет в массиве. В этом случае добавляем слово в массив.
      if j = Cnt then begin
        //Количество значимых элементов массива теперь увеличилось на 1.
        Inc(Cnt);
        //Если требуется, увеличиваем длину массива.
        if Cnt > Length(Arr) then SetLength(Arr, Cnt + Capacity);
        //Добавляем сведения о слове в массив.
        Arr[j].SWord := SWord;
        Arr[j].Cnt := 1;
      end;
      //Уточняем сведения о наибольшем количестве присутствий слова.
      if Arr[j].Cnt > CntMax then CntMax := Arr[j].Cnt;
      //Сброс длины слова.
      LenW := 0;
    end;
  end;
  //Записываем в результирующую строку только те слова,
  //которые присутствуют в тексте наиболее часто.
  Result := '';
  for i := 0 to Cnt - 1 do
    if Arr[i].Cnt = CntMax then begin
      if Result <> '' then Result := Result + ', ';
      Result := Result + Arr[i].SWord;
    end;
end;
//Проверка.
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo2.Text := ProcStr(Memo1.Text);
end;