Строки, Как вывести в порядке частоты появления... Опции

[Вася]

Условие задачи:
Пусть задан текст представляющий собой последовательность строк. Признак конца текста вводится пользователем. Выведите на печать количество каждой содержащейся в строке латинских и русских прописных букв в порядке частоты их появления.
А вот и решение:

Код

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 - 3.06.2007 23:29

[Артемий]

Это да,невнимательно я..

[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 - 4.06.2007 2:13

[Вася]

Отлично! Спасибо. Проверил - вроде работает. Но мне не совсем всё понятно ты не мог бы написать к ней коментарии?

[volvo]

Комментарии добавлены ...

[Вася]

Спасибо, теперь понятно.