Получить самый большой из длин отрезков, которые рассматриваются - Pascal ABC

Формулировка задачи:

Составить программу с использованием функций и процедур: 2. Задано натуральное n, целые числа a1,a2,..., an. Просмотреть отрезки последовательности a1,a2,..., an (последовательности элементов, которые идут подряд), которые составляются из а) степеней натурального m б) простых чисел. В Каждом случае получить самый большой из длин отрезков, которые рассматриваются.

Код к задаче: «Получить самый большой из длин отрезков, которые рассматриваются - Pascal ABC»

textual
type
    TArray = Array[Byte] Of LongInt;
    TFunc = Function(const x, m: LongInt): Boolean;
procedure InputArray(var ar: TArray; var n: Byte); //процедура ввода массива
var
    i: Byte;
begin
    repeat
        Write('Input n (1..255): '); ReadLn(n); //запрашиваем n
    until (n > 0);
    for i := 0 to n - 1 do
    begin
        Write('ar[', i + 1, ']='); ReadLn(ar[i]); //запрашиваем элементы массива
    end;
end;
{$F+}
function IsPrime(const x, m: LongInt): Boolean; //функция процерки "на простоту" числа
var
    i: LongInt;
begin
    Result := (x >= 2); //простые числа начинаются с 2 (wiki в помощь)
    if (Result)
    then
    begin
        i := 2;
        while ((i <= x div 2) And (Result)) do //ищем возможный делитель на промежутке от 2 до половины значения заданного числа.
        begin
            Result := x mod i <> 0;
            Inc(i);
        end;
    end;
    IsPrime := Result;
end;
function IsDivisible(const x, m: LongInt): Boolean; //проверка на степень (является ли число степенью числа m)
var
    mm: LongInt;
begin
    mm := 1;
    while (x > mm) do
        mm := mm * m; //новая степень
    IsDivisible := x = mm; //проверяем является ли x степенью числа m
    //если честно - хз что я тут писал о_О какой-то наркоманский бред
end;
{$F-}
procedure CheckForMax(var max, id: Byte; const count, posit: Byte); //проверяет нашли ли мы новый максимум. если нашли - запоминаем новые значения
begin
    if (max < count) //если предыдущий максимум меньше найденного
    then //обновляем значения
    begin
        max := count;
        id := posit - count;
    end;
end;
procedure Process(const ar: TArray; const n: Byte; const c: Char; const m: LongInt; f: TFunc); //процедура, принимающая в параметрах, между прочих, функцию (чтоб не писать дважды один и тот же код)
var
    i, max, count, id: Byte;
begin
    count := 0; max := 0; id := 0; //инициализация переменных
    for i := 0 to n - 1 do //по каждому элементу массива
        if (f(ar[i], m)) //если число прошло проверку
        then
            Inc(count) //увеличиваем счётчик
        else //иначе
        begin
            CheckForMax(max, id, count, i);  //проверяем максимумы
            count := 0; //обнуляем счётчик
        end;
    CheckForMax(max, id, count, n); //контрольная проверка
    WriteLn('max', c, '=', max, ' from ', id + 1); //выводим результат
end;
var
    arr: TArray;
    n: Byte;
    m: LongInt;
begin
    InputArray(arr, n);
    repeat
        Write('Input m (>0): '); ReadLn(m); //вводим m
    until (m > 0);
    Process(arr, n, 'A', m, IsDivisible); //ищем наибольную последовательность числе-степеней m
    Process(arr, n, 'B', 0, IsPrime); //ищем наибольшую последовательность простых чисел
  ReadLn;
end.

8   голосов, оценка 4.375 из 5


СОХРАНИТЬ ССЫЛКУ