NCK DELPHI FINAL

1.dpr

program First;

{$APPTYPE CONSOLE}

// Дан одномерный массив Yn.
// Найти минимальный среди положительных элементов
// с четными номерами.
// Удалить каждый третий элемент.

(*
 * Тестовые входные данные:
 *
 * 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, j, min : integer;
  wr: boolean;

begin

  SetConsoleCP( 1251 );
  SetConsoleOutputCP( 1251 );

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

  Setlength( y , yn );

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

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

  writeln;

  write( '{ ' );

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

  write( '}' );

  writeln;

  min := -1;
  i := 0;
  offset := 0;
  wr := false;

  while i < yn do begin

	  if ( i mod 2 = 0 ) and ( y[ i ] > 0 ) and ( ( y[ i ] < min ) or ( min = -1 ) ) then min := y[ i ];

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

    if ( ( i + 1 ) mod 3 = 0 ) then inc( offset );

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

      wr := false;

    end;

    wr := ( ( i + 1 ) mod 3 = 0 );

	  inc( i );

  end;

  writeln;

  if ( min <> -1 ) then writeln( 'Минимальный среди положительных элементов: ' , min ) else writeln('Минимальный среди положительных элементов не найден');;

  write( '{ ' );

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

  write( '}' );

  readln;

end.

2.dpr

program Second;

{$APPTYPE CONSOLE}

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

(*
 * Тестовые входные данные:
 *
 * 4
 * 4
 * 2.53 5 63 53.53
 * 1.15 1 7 56.465745
 * 2.43 2 24.263 6.74
 * 2.54 3 75.7457 2
 *
 *)

uses
  SysUtils, Windows, Math;

var
	x : array of array of extended;
  y : array of integer;
  xn, xm, i, j, yn, s : 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
    
    writeln('Введите ' , xm , ' элементов массива строки ' , i , ': ');

    for j := 0 to xm - 1 do read( x[ i ][ j ] );

  end;

  writeln;

  for i := 0 to xn - 1 do 
  begin

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

    writeln;

  end;

  writeln;

  yn := xn div 2;

  Setlength( y, yn );

  i := 0;

  while i < xn do 
  begin
      
    s := 0;

    for j := 0 to xm - 1 do
      if ( x[ i + 1 ][ j ] = Ceil( x[ i + 1 ][ j ] ) ) then inc( s );

    find := (s <> 0) or find;

    y[ (i div 2) ] := s;

    i := i + 2;

  end;

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

    for i := 0 to yn - 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 -1 -42 32
 * 23 -29 65 -5
 * 12 -58 -5 -22
 * 23 52 8 9
 *
 *)

uses
  SysUtils, Windows;

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

begin

  SetConsoleCP( 1251 );
  SetConsoleOutputCP( 1251 );

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

  Setlength( x , xn , xn );

  for i := 0 to xn - 1 do 
  begin
    
    writeln('Введите ' , xn , ' элементов массива строки ' , i , ': ');

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

  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;

  s := 0;
  c := 0;

  for i := 0 to xn - 1 do
  begin
    
    j := 0;

    while j < xn do
    begin

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

      if ( x[ i ][ j ] < 0 ) then inc( c );

      j := j + 2;

    end;

  end;

  if ( c <> 0 ) then a := s / c else a := 0;

  for i := 0 to xn - 1 do
    for j := 0 to i - 1 do
      x[ i ][ j ] := a;

  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.