Написать программу, которая считает какие числа и сколько раз встречаются в файле — Pascal(Паскаль)

program Project1;
 
const
  N = 200;
 
type
  TNumInfo = record
    Num : Integer;
    Cnt : Integer;
  end;
  TArrNums = array[1..N] of TNumInfo;
 
(*Обновляет статистику по числу aNum - если число уже есть в массиве, то увеличивает его счётчик,
если числа нет в массиве, то добавляет сведения о нём.*)
procedure AddToArr(var aArr : TArrNums; const aNum : Integer; var aN : Integer);
var
  i : Integer;
  BFound : Boolean;
begin
  (*Если запись о числе уже есть в массиве, то увеличиваем счётчик в этой записи.*)
  BFound := False;
  for i := Low(aArr) to aN do begin
    if aArr[i].Num = aNum then begin
      Inc( aArr[i].Cnt );
      BFound := True;
      Break;
    end;
  end;
  (*Если записи в массиве нет - добавляем запись.*)
  if not BFound then begin
    Inc(aN);
    aArr[aN].Num := aNum;
    aArr[aN].Cnt := 1;
  end;
end;
 
(*Извлекает из строки числа и добавляет их в массив.*)
procedure ProcStr(const aStr : String; var aArr : TArrNums; var aN : Integer);
const
  (*Множество цифр.*)
  D = ['0'..'9'];
  (*Множество разделитлей.*)
  Dl = [
    ' ', #9, #10, #13,
    '.', ',', ':', ';',
    '+', '-', '*', '/', '=', '#', '''',
    '(', ')', '[', ']', '{', '}'
  ];
var
  (*i - Индекс символов в строке, Pos1, Pos2 - позиции начала и конца записи числа.*)
  i, Pos1, Pos2, Num, ErrCode : Integer;
begin
  (*Выделяем целые числа и помещаем их в массив.*)
  Pos1 := 0;
  Pos2 := 0;
  for i := 1 to Length(aStr) do begin
    (*Пропускаем знаки, отличные от цифр.*)
    if not (aStr[i] in D) then Continue;
    (*Отслеживаем начало записи числа.*)
    if i = 1 then
      Pos1 := i
    else if aStr[i - 1] in Dl then
      Pos1 := i
    ;
    (*Отслеживаем конец записи числа.*)
    if Pos1 > 0 then begin
      if i = Length(aStr) then
        Pos2 := i
      else if aStr[i + 1] in Dl then
        Pos2 := i
      ;
    end;
    (*Если найден конец записи числа.*)
    if Pos2 > 0 then begin
      (*Определяем число.*)
      Val(Copy(aStr, Pos1, Pos2 - Pos1 + 1), Num, ErrCode);
      (*Обновляем статистику.*)
      AddToArr(aArr, Num, aN);
      (*Обнуляем флаги.*)
      Pos1 := 0;
      Pos2 := 0;
    end;
  end;
end;
 
var
  F : Text;
  Arr : TArrNums;
  i, j : Integer;
  Str1 : String;
begin
  j := 0;
  repeat
    Writeln('Задайте имя файла:');
    Readln(Str1);
    (*Попытка открытия файла.*)
    Assign(F, Str1);
    {$I-}
    Reset(F);
    {$I+};
    if IOResult <> 0 then begin
      Writeln('Ошибка! Не удалось открыть файл с заданным именем.');
      Writeln('Возможно файла с таким именем не существует.');
      Writeln('Действие отменено.');
      Str1 := '';
      Continue;
    end;
    (*Обработка файла.*)
    while not Eof(F) do begin
      Readln(F, Str1);
      ProcStr(Str1, Arr, j);
    end;
    (*Закрываем файл.*)
    Close(F);
    (*Вывод результатов.*)
    Writeln('Найдено различных чисел: ', j);
    for i := Low(Arr) to j do begin
      Writeln('Число: ', Arr[i].Num, ', количество: ', Arr[i].Cnt);
    end;
    Writeln('Выход - Enter, повторить - любой символ + Enter.');
    Readln(Str1);
  until Str1 <> '';
end.

Leave a Comment

1 + 2 =