Задача 12. Найти максимальный элемент числового массива.

Решение

Способ

Program Problem1 2;

uses WinCrt;

const

       n = 20;

 type

          t = array [1..n] of integer;

 var

       a: t;

       max: integer;

{----------------------------------------------------------------------------------------}

Procedure create(n: integer; var a: t);

    var

        i: integer;

    begin

        randomize;

        writeln('Заданный массив целых чисел');

          for i:= 1 to n do

            begin

                a[i]:= random(201) - 101;

                write(a[i], ' ')

            end;

       writeln

    end;

{----------------------------------------------------------------------------------------}

Procedure maximum(n: integer; a: t; var max: integer);

     var

         i: integer;

     begin

        max:= a[1];

        for i:= 2 to n do if max < a[i] then max:= a[i]

     end;

{----------------------------------------------------------------------------------------}

begin

  create(n, a);

  maximum(n, a, max);

  writeln(' Наибольший элемент массива ', max)

end.

Способ

Program Problem1 2 a; { Рекурсия }

uses WinCrt;

 const

       n = 20;

type

       t = array [1..n] of integer;

var

       a: t;

       max: integer;

{----------------------------------------------------------------------------------------}

Procedure create(n: integer;  var a: t);

    var

        i: integer;

    begin

        randomize;

        writeln('Заданный массив целых чисел');

            for i:= 1 to n do

             begin

                 a[i]:= random(201) - 101;

                 write(a[i], ' ')

             end;

        writeln

       end;

{----------------------------------------------------------------------------------------}

  Procedure maximum(n: integer; var max: integer);

       label 1;

       begin

           if n = 0 then goto 1

                        else if a[n] > max then max:= a[n];

           maximum(n - 1, max);

   1: end;

{----------------------------------------------------------------------------------------}

begin

  create(n, a);

  maximum(n, max);

  writeln(' Наибольший элемент массива ', max)

  end.

Задача 13. Процедура упорядочивания массива выбором.

 

Решение

Procedure choice(n: integer);

var

    i, j, k, p: integer;

begin

   for i:= 1 to n do

      begin

          k:= i;

             for j:= i + 1 to n do if x[j] < x[k] then k:= j;

          p:= x[i]; x[i]:= x[k]; x[k]:= p

      end;

    writeln(' Упорядоченный массив ');

    for i:= 1 to n do write(x[i], ' '); writeln

  end;

 

Задача 14.  Вычислить значение многочлена используя формулу Горнера. Коэффициенты полинома удобно представить массивом (2; 0; -1; 4; 0; 0; -5; 6; 1). Порядок полинома n равен 8.

Решение

Способ

Program Problem 14;

uses WinCrt;

  const

       n = 8;

 type

       t = array [1..n+1] of real;

var

       a: t;

       y, x: real;

       i: integer;

{----------------------------------------------------------------------------------------}

Procedure gorner(x: real; a: t; var y: real);

    var

         i: integer;

    begin

       y:= a[1];

       for i:= 2 to n + 1 do y:= y*x + a[i];

       writeln('Значение многочлена равно ', y:6:6)

      end;

{----------------------------------------------------------------------------------------}

begin

   for i:= 1 to n + 1 do

      begin

         write(' Введите ', i, '- й коэффициент ');

          readln(a[i])

      end;

    writeln(' Коэффициенты полинома ');

    for i:= 1 to n + 1 do write(a[i]:3:3, ' ');

  writeln;

  write('Введите значение аргумента x '); readln(x);

  gorner(x, a, y)

end.

Способ

Program Problem 14 a;

uses WinCrt;

const

        n = 8;

type

        t = array [1..n+1] of real;

var

       a: t; y, x: real; i: integer;

{----------------------------------------------------------------------------------------}

Procedure polynomial(k: integer; x: real; var y: real);

       label 1;

       begin

            if k = -1 then goto 1

                          else

                            begin

                               y:= y*x + a[n-k+1];

                               polynomial(k-1, x, y)

                            end;

   1: end;

{----------------------------------------------------------------------------------------}

    begin

        for i:= 1 to n + 1 do

           begin

              write(' Введите ', i, '- й коэффициент '); readln(a[i])

            end;

         write('Введите значение аргумента x '); readln(x);

         polynomial(n, x, y);

         writeln('Значение многочлена равно ', y:6:6)

    end.

 

Задача 15. Процедура "решето Эратосфена".

 

Решение

Procedure eratosfen(n: integer; a: t; var c: t; var k: integer);

var

     f, i, j, b: integer;

begin

   f:= trunc(sqrt(n));

     for i:= 2 to f do

        begin

            if a[i] <> 0 then

              begin

                  b:= a[i];

                   j:= b*2;

                     while j <= n do

                      begin

                          if a[j] <> 0 then

                                               begin

                                                  if a[j] mod b = 0

                                                     then a[j]:= 0;

                                                     j:= j + b

                                              end

                                           else

                                         j:= j + b

                         end

              end

        end;

    k:= 0;

    for i:= 2 to n do

       if a[i] <> 0 then

         begin

            k:= k + 1;

            c[k]:= a[i]

         end;

end;

 

Задача 16. Рассмотрим программу ввода с клавиатуры третьего массива чисел с последующим выводом в виде таблицы на экран.

Решение

Program Problem1 6;

uses WinCrt;

const

       m = 4; n = 5;

type

       s = array [1..m] of integer;

       t = array [1..n] of s;

var

       a: t;

       i, j: integer;

begin

   for i:= 1 to n do

      for j:= 1 to m do

        begin

           write('Введите элемент ', i, '-й строки ');

      write(j, '- го столбца '); readln(a[i, j])

        end;

   writeln('Заданный двумерный числовой массив');

   for i:= 1 to n do

      begin

          for j:= 1 to m do write(a[i, j]:6, ' ');

          writeln

        end

end.

 

Задача 17. В двумерном массиве найдите наибольшие элементы каждой строки.

Решение

Program Problem 17.;

uses WinCrt;

const

       n = 4; m = 5;

 type

      s = array [1..m] of integer;

      t = array [1..n] of s;

      st = array [1..n] of integer;

var

      a: t;

      b: st;

{----------------------------------------------------------------------------------------}

 Procedure create_two(n, m: integer; var a: t);

     var

          i, j: integer;

     begin

        writeln('Заданный двумерный массив целых чисел');

        randomize;

            for i:= 1 to n do

               begin

                  for j:= 1 to m do

                     begin

                         a[i, j]:= random(201) - 100;

                         write(a[i, j]:6, ' ')

                     end;

                    writeln

               end

     end;

{----------------------------------------------------------------------------------------}

Procedure maxim_line(n, m: integer; a: t; var b: st);

     var

          i, j: integer;

     begin

        for i:= 1 to n do

           begin

              b[i]:= a[i, 1];

               for j:= 1 to m do

                   if a[i, j] > b[i] then b[i]:= a[i, j];

            end;

         writeln('Наибольшие элементы каждой строки массива');

         for i:= 1 to n do write(b[i]:6, ' ');

         writeln

     end;

{----------------------------------------------------------------------------------------}

begin

   create_two(n, m, a);

   maxim_line(n, m, a, b)

end.

Задача 18. Сформировать матрицу размерности  из случайных чисел от 1 до 100. Расположить их в порядке возрастания по следующей схеме (см. рис.):

Решение

Алгоритм

Эта задача является логическим продолжением задачи примера 4. В самом деле, чтобы расположить элементы массива по такой схеме и выполнить условие задачи - упорядочить элементы в порядке возрастания, надо:

1) "растянуть" матрицу в одномерный массив;

2) упорядочить полученный массив в порядке возрастания;

3) "выбрать" из полученного одномерного массива столбцы с расположением элементов по предложенной схеме.

Первый пункт этого алгоритма выполнить нетрудно, основываясь на предыдущем примере.

Упорядочить полученный одномерный массив можно с помощью процедуры быстрой сортировки.

Третий пункт является для нас новым. Чтобы выполнить его, надо заметить следующую закономерность. Если столбец двумерного массива имеет нечетный номер, т. е. 1-й, 3-й, 5-й и т.д., тогда элементы располагаются в порядке возрастания от 1-го элемента столбца до n-го - "сверху вниз".

Если номера столбцов четные, т. е. 2-й, 4-й, 6-й и т. д., тогда элементы располагаются от n-го до 1-го - "снизу вверх".

Теперь можно составить схему программы.

 

Схема программы

Program Problem18;

Описание массивов и переменных.

Процедура быстрой сортировки.

 begin

Создание двумерного массива с помощью функции случайных чисел и одновременное "растягивание" в одномерный массив, а также вывод полученной    матрицы на экран.

Вызов процедуры быстрой сортировки и сортировка одномерного массива в порядке возрастания.

 v:= 1; - счетчик столбцов матрицы, получаемой из отсортированного одномерного массива;

 k:= 0; - счетчик элементов одномерного массива;

        repeat

            if v mod 2 <> 0 then

                                         for i:= 1 to n do

                                            begin

                                                k:= k + 1;

                                                a[i, v]:= b[k]

                                            end

                                     else

                                        for i:= n downto 1 do

                                           begin

                                              k:= k + 1;

                                              a[i, v]:= b[k]

                                           end;

            v:= v + 1

         until v = m + 1;

    Вывод массива на экран.

end.

Program Problem 18;

uses WinCrt;

 const

       n = 5; m = 6;

type

       s = array [1..m] of integer; t = array [1..n] of s; f = array [1..n*m] of integer;

 var

       a: t;

       b: f;

      i, j, k, v: integer;

{----------------------------------------------------------------------------------------}

Procedure create_two(n, m: integer; var a: t);

    var

        i, j: integer;

    begin

       writeln('Заданный двумерный массив целых чисел');

       randomize;

       for i:= 1 to n do

          begin

             for j:= 1 to m do

                begin

                   a[i, j]:= random(201) - 100;

                   write(a[i, j]:6, ' ')

                end;

             writeln

         end

    end;

{----------------------------------------------------------------------------------------}

 Procedure sprain(n, m: integer; a: t; var b: f);

    var

        k, i, j: integer;

    begin

        k:= 0;

        for i:= 1 to n do

          for j:= 1 to m do

             begin

                k:= k + 1;

                b[k]:= a[i, j]

             end

    end;

{----------------------------------------------------------------------------------------}

Procedure fast(q, p: integer; var b: f);

    var

        s, l, r: integer;

    begin

        l:= q; r:= p;

        s:= b[l];

           repeat

             while (b[r] >= s) and (l < r) do r:= r - 1;

             b[l]:= b[r];

             while (b[l] <= s) and (l < r) do l:= l + 1;

             b[r]:= b[l]

           until l = r;

       b[l]:= s;

       if q < l - 1 then fast(q, l - 1, b);

       if l + 1 < p then fast(l + 1, p, b)

    end;

{----------------------------------------------------------------------------------------}

begin

create_two(n, m, a);

sprain(n, m, a, b);

fast(1, n*m, b);

 for i:= 1 to n*m do write(b[i], ' '); writeln;

v:= 1; k:= 0;

   repeat

      if v mod 2 <> 0 then

                                   for i:= 1 to n do

                                     begin

                                        k:= k + 1;

                                        a[i, v]:= b[k]

                                     end

                               else

                                 for i:= n downto 1 do

                                     begin

                                        k:= k + 1;

                                        a[i, v]:= b[k]

                                     end;

      v:= v + 1

   until v = m + 1;

writeln('Массив расположения элементов по схеме');

   for i:= 1 to n do

      begin

         for j:= 1 to m do write(a[i, j]:6, ' '); writeln

      end

end.