Помощь - Поиск - Пользователи - Календарь
Полная версия: Строки
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Вася
Условие задачи:
Пусть задан текст представляющий собой последовательность строк. Признак конца текста вводится пользователем. Выведите на печать количество каждой содержащейся в строке латинских и русских прописных букв в порядке частоты их появления.
А вот и решение:
Код

program stroki;
var
  s: string;        
  i, k, j: integer;
  eot: char;        

procedure read_str (var s: string);
begin
    write('введите строку: ');
    readln(s);
end;

procedure poisk (var s: string; var i, k: integer);
var j: integer;
begin
    for j:= i+1 to length(s) do
    if s[j] = s[i] then
    begin
        k:= k +1;
        s[j]:= '!';
    end;
end;
begin
  SetConsoleCp(1251);
  SetConsoleOutPutCP(1251);
  writeln ('введите признак конца текста:');
  readln (eot);
  writeln('введите текст:');
  read_str (s);
  while s <> eot do
    begin

      for i:= 1 to length(s) do
        begin
          k:= 1;
          
          if s[i] in ['A'..'Z'] then
          begin
            poisk (s, i, k);
            writeln(s[i], ' - ', k);
          end;
          
            if (ord(s[i]) in [192..223])   then
            begin
              poisk (s, i, k);
              writeln(s[i], ' - ', k);
             end;
        end;
        read_str (s);
      end;
end.

Вопрос: как сделать так, чтобы на печать выводилось количество каждой содержащейся в строке латинских и русских прописных букв в порядке частоты их появления??? Пожалуйста исправьте.
Артемий
while s <> eot do begin

Допустим eot это символ окончания.Получается,что цикл неверен,правильнее было бы
while s[i] <> eot do begin
*********
inc(i);
end;
volvo
Цитата
Получается,что цикл неверен
Это почему? Вводится же несколько строк, пока ВСЯ введенная строка не будет состоять из одного символа окончания - цикл продолжается... Как раз здесь все верно...
Артемий
Это да,невнимательно я..
volvo
Вася, можно уточнить, как именно ты хочешь чтобы выводились символы? К примеру, введена строка:

"чтобы правильно задать вопрос, нужно знать большую часть ответа" Что ты хочешь видеть в результате обработки данной строки?
Вася
Если для ИМЕННО ТАКОЙ строки, то пусть ничего не выводит. А вот если в ней содержались бы ПРОПИСНЫЕ буквы, то я хотел бы, чтобы получалось например так:
Вводим: А В В В В В Ы Ы Ы Ф
В этой программе получаем:
А - 1
В - 5
Ы - 3
Ф - 1
А надо:
А - 1
Ф - 1
Ы - 3
В - 5
То же и для латинских.
volvo
Тогда так:

program stroki;
type
r = record
ch: char;
count: integer;
end;

procedure poisk(const s: string; var arr: array of r;
var count: integer);


// процедура пересортировывает (пузырьком) массив arr по возрастанию ...
procedure sort;
var
i, j: integer;
T: r;
begin
for i := 0 To count do
for j := count downto i + 1 do
if arr[pred(j)].count > arr[j].count then begin // ... счетчика повторений
T := arr[pred(j)]; arr[pred(j)] := arr[j]; arr[j] := T
end
end;

const chars = ['A' .. 'Z', 'А' .. 'Я'];
var
i, j: integer;
found: boolean;
begin
count := -1; // в начале - считаем массив данных пустым
for i := 1 to length(s) do begin // для каждого символа строки делаем следующее

found := false; // флаг - показывает, найден ли текущий символ среди ранее обработанных

for j := 0 to count do begin // проверяем все РАНЕЕ записанные символы, ...
if arr[j].ch = s[i] then begin // ... и если текущий равен одному из них, то ...
inc(arr[j].count); found := true // увеличиваем счетчик, и устанавливаем флаг
end;
end;

// если флаг не установлен (т.е., символ РАНЕЕ не был найден),
// и текущий символ - прописная буква ...
if (not found) and (s[i] in chars) then begin
// ... то увеличиваем количество записей в массиве на 1,
// и запоминаем текущий символ (его счетчик повторений устанавливаем в 1)
inc(count); arr[count].ch := s[i]; arr[count].count := 1;
end;

end;
// Прошли по всей строке, в массиве arr содержится информация о символах
// и числе их повторений в порядке появления символов в строке, но это не то,
// что требуется... Поэтому пересортировываем массив по возрастанию счетчика
// повторений.
sort;
end;

procedure read_str (var s: string);
begin
write('введите строку: ');
readln(s);
end;

var
s: string;
eot: char;
arr: array[0 .. 50] of r;
i, n: integer;


begin
SetConsoleCp(1251);
SetConsoleOutPutCP(1251);
writeln ('введите признак конца текста:'); readln (eot);
writeln('введите текст:'); read_str (s);

while s <> eot do begin

poisk(s, arr, n);
for i := 0 to n do
writeln(arr[i].ch, ' : ', arr[i].count:3);
read_str (s);

end;
end.
Проверяй, ибо набирал прямо здесь - мог чего-то напортачить...
Вася
Отлично! Спасибо. Проверил - вроде работает. Но мне не совсем всё понятно ты не мог бы написать к ней коментарии?
volvo
Комментарии добавлены ...
Вася
Спасибо, теперь понятно.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.