Pascal строки

excel

Местный житель
Регистрация
12 Май 2013
Сообщения
154
Реакции
22
Помогите пожалуйста сворганить след.прогу. Не очень толковый программист из меня, так что надеюсь на более сообразительных
Вводится строка. Слова в строке отделяются пробелом или запятой. Определить какое слово в строке встречается чаще всего
 
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.
 
Последнее редактирование:
Помогите пожалуйста сворганить след.прогу. Не очень толковый программист из меня, так что надеюсь на более сообразительных
на делфи
Код:
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;
 
Назад
Сверху