NDRW DELPHI FINAL

1.dpr

program First;

{$APPTYPE CONSOLE}

// Дан одномерный массив Хк.
// Найти последний среди элементов с четными значениями.
// Все отрицательные элементы массива удалить.
// В конец массива дописать среднее арифметическое положительных элементов.

(*
 * Тестовые входные данные:
 *
 * 17
 * 35 
 * -12 
 * -24 
 * 352 
 * -5
 * -5
 * 61
 * -17
 * 52
 * -16
 * -34
 * -43
 * -36
 * 834
 * 74
 * 234
 * 215
 *
 *)

uses
  SysUtils, Windows;

var
	y : array of integer;
  yn, i, offset, sum, counter, last : integer;
  wr: boolean;

begin

  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);

	write('Введите размер массива: ');
  read(yn);

  Setlength(y, yn + 1);

  writeln('Введите массив: ');

	for i := 0 to yn - 1 do begin

    write('x[' , i , '] = ');
    read(y[i]);

  end;

  writeln;

  write('{ ');

  for i := 0 to yn - 1 do write(y[i], ' ');

  write('}');

  writeln;

  last := -1;
  i := 0;
  offset := 0;
  sum := 0;
  counter := 0;
  wr := false;

  while i < yn do begin

    if ( wr ) then begin
      
      writeln('');
      writeln('Удален элемент x[' , ( i - 1 ) , '] = ' , y[ i - 1 ]);

      wr := false;

    end;

    if (y[i] mod 2 = 0) then last := y[i];

    if (y[i] > 0) then begin

      sum := sum + y[i];
      inc(counter);
      
    end;

    y[i - offset] := y[i];

    if (y[i] < 0) then inc(offset);

    wr := (y[i] < 0);

    inc(i);

  end;

  y[yn - offset] := sum div counter;

  writeln;

  if (last <> -1) then writeln('Последний среди элементов с четными значениями: ', last) else writeln('Элементов с четными значениями не найдено');

  write('{ ');

  for i := 0 to yn - offset do write(y[i], ' ');

  write('}');

  readln;

end.

2.dpr

program Second;

{$APPTYPE CONSOLE}

// Сформировать одномерный массив,
// состоящий из сумм четных элементов,
// располагающихся в нечетных строках матрицы X (n x m).

(*
 * Тестовые входные данные:
 *
 * 4
 * 4
 * 253
 * 5
 * 63
 * 53
 * 115
 * 1
 * 7
 * 565
 * 243
 * 2
 * 243
 * 674
 * 2
 * 3
 * 75
 * 2
 *
 *)

uses
  SysUtils, Windows;

var
  x : array of array of integer;
  y : array of integer;
  xn, xm, i, j, yn, s, si : integer;
  find: boolean;

begin

  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);

  write('Введите количество строк: ');
  read(xn);

  write('Введите количество столбцов: ');
  read(xm);

  Setlength(x, xn, xm);

  find := false;

  for i := 0 to xn - 1 do 
  begin

    for j := 0 to xm - 1 do begin

      write('x[' , i , '][' , j , '] = ');
      read(x[i][j]);

    end;

  end;

  writeln;

  for i := 0 to xn - 1 do 
  begin

    for j := 0 to xm - 1 do write(x[i][j]:5, #9);

    writeln;

  end;

  writeln;

  yn := xn div 2;

  Setlength(y, yn);

  i := 1;
  si := 0;

  while i < xn do 
  begin

    s := 0;

    for j := 0 to xm - 1 do begin

      if (x[i][j] mod 2 = 0) then s := s + x[i][j];

      find := (x[i][j] mod 2 = 0) or find;
      
    end;

    if (s <> 0) then 
    begin
      y[si] := s;
      inc(si);
    end;

    i := i + 2;

  end;

  if (find) then begin
     
    write('{ ');

    for i := 0 to si - 1 do write(y[i], ' ');

    write('}');

  end
  else
  begin

  write('Четных элементов в нечетных строках не найдено');

  end;

  readln;

end.

3.dpr

program Third;

{$APPTYPE CONSOLE}

// Все элементы матрицы X (n x n),
// лежащие выше второстепенной диагонали,
// заменить количеством элементов с дробной частью,
// лежащих на главной диагонали.

(*
* Тестовые входные данные:
*
* 4
* 1.34
* -1
* -42
* 32
* 23
* -29
* 65
* -5.8
* 12
* -58
* -5
* -22
* 23
* 52
* 8
* 9.342
*
*)

uses
  SysUtils, Windows, Math;

var
	x : array of array of extended;
  xn, i, j, c : integer;

begin

  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);

	write('Введите размер матрицы: ');
  read(xn);

  Setlength(x, xn, xn);

  for i := 0 to xn - 1 do begin

    for j := 0 to xn - 1 do begin

      write('x[' , i , '][' , j , '] = ');
      read(x[i][j]);

    end;

  end;

  writeln;

  for i := 0 to xn - 1 do begin

    for j := 0 to xn - 1 do
      write(x[i][j]:8:2, #9);

    writeln;

  end;

  writeln;

  c := 0;

  for i := 0 to xn - 1 do
    if (x[i][i] <> Ceil(x[i][i])) then
      inc(c);

  for i := 0 to xn - 1 do
    for j := 0 to xn - (i + 2) do
      x[i][j] := c;

  for i := 0 to xn - 1 do 
  begin

    for j := 0 to xn - 1 do
      write(x[i][j]:8:2, #9);

    writeln;
    
  end;

  readln;

end.