Примеры решения задач...

Список задач:

• 1. Задан массив A из 100 чисел. Описать функцию для определения количества нечетных чисел среди его первых N элементов. В качестве параметров взять A и N. Если нечетных нет, то результат функции - число 7777777.
• 2. Задан двумерный целочисленный массив G размером 10 на 10 элементов. Написать процедуру для определения числа тех строк массива, которые не содержат чисел из первой строки.
• 3. Даны 2 матрицы A(M,N) и B(N,N). Подсчитать и вывести на экран общее количество отрицательных элементов, определить в какой из матриц среднее арифметическое значение прочих элементов имеет большую величину.
• 4. Дан вещественный массив X(M) найти элемент массива, значение которого наиболее близко к какому нибудь целому числу.
• 5. Составить программу, выводящую на экран номера элементов массива, кратных четырем.
• 6. Составить алгоритм и программу для сортировки массива по следующему принципу следования элементов: максимальный элемент, минимальный элемент, 2й по величине, предпоследний, 3й по величине, 3й с конца и т.д.
• 7. Задача: определить номер минимального элемента заданного одномерного массива.

1. Задан массив A из 100 чисел. Описать функцию для определения количества нечетных чисел среди его первых N элементов. В качестве параметров взять A и N. Если нечетных нет, то результат функции - число 7777777.

uses crt;
var
  a:array[1..100] of integer;
  i,n:integer;
function Nech(b:array of integer; m:integer):word;
var
  k,j:integer;
begin
  k:=0;
  j:=0;
  for j:=1 to m do
  begin
	 if b[j] mod 2<>0 then k:=k+1;
  end;
  if k=0 then Nech:=7777 else Nech:=k;
end;
begin
  ClrScr;
  Randomize;
  for i:=1 to 100 do
  begin
	 a[i]:=random(9)+1;
	 write(a[i]:2);
  end;
  writeln;
  write('Input n -> ');readln(n);
  writeln('Output -> ',Nech(a,n));
  readln;
end.

2. Задан двумерный целочисленный массив G размером 10 на 10 элементов. Написать процедуру для определения числа тех строк массива, которые не содержат чисел из первой строки.

uses crt;
const n=5;{ Размерность массива }
var
  a:array[1..n,1..n] of integer;
  q:array[1..n] of integer;
  i,j,k,y,t:integer;
  b:boolean;
begin
  ClrScr;
  Randomize;
  {=== Заполняем массив ===}
  for i:=1 to n do
  begin
	 for j:=1 to n do
	 begin
	  a[i,j]:=random(99)+1;
	  write(a[i,j]:4);
	 end;
	 writeln;
  end;
  {--------- Begin --------}
  k:=0;t:=1;
  for i:=2 to n do
  begin
	 b:=true;
	 for j:=1 to n do
	 begin
	  for y:=1 to n do
		 if a[i,j]=a[1,y] then
		 begin
			b:=false;
			break;
		 end;
	  end;
	  if b then
	  begin
	   k:=k+1;
	   q[t]:=i;
	   t:=t+1;
	  end;
  end;
  {---------- End ---------}
  writeln('Таких строк: ',k);
  write('Вот их номера: ');for i:=1 to t-1 do write(q[i],' ');
  readln;
end.

3. Даны 2 матрицы A(M,N) и B(N,N). Подсчитать и вывести на экран общее количество отрицательных элементов, определить в какой из матриц среднее арифметическое значение прочих элементов имеет большую величину.

program too_matrix;
const
  m=4;
  n=5;
var
  A:array[1..m,1..n] of integer;
  B:array[1..n,1..n] of integer;
  i,j,Sa,Sb,k: integer;
  ka,kb	  : integer;
  SredA,SredB: real;
begin
  k:=0; ka:=0; kb:=0;
  for i:=1 to m do
  begin
	 for j:=1 to n do
	 begin
	  a[i,j]:=random(10)-5;
	  write(a[i,j]:3);
	  if a[i,j]<0 then begin k:=k+1; ka:=ka+1; Sa:=Sa+abs(a[i,j]); end;
	 end;
	 writeln;
  end;
  writeln;
  for i:=1 to n do
  begin
	 for j:=1 to n do
	 begin
	  b[i,j]:=random(10)-5;
	  write(b[i,j]:3);
	  if b[i,j]<0 then begin k:=k+1; kb:=kb+1; Sb:=Sb+abs(b[i,j]); end;
	 end;
	 writeln;
  end;
  writeln('Elements < 0: ',k);
  if ka<>0 then SredA:=Sa/ka;
  if kb<>0 then SredB:=Sb/kb;
  if SredA>SredB then writeln('В массиве A среднее арифметическое отрицательных элементов больше.')
  else if SredB>SredA then writeln('В массиве B среднее арифметическое отрицательных элементов больше.')
				  else writeln('Одинаково!');
  readln;
end.

4. Дан вещественный массив X(M) найти элемент массива, значение которого наиболее близко к какому нибудь целому числу.

program n_2;
const
  m=10;
var
  x : array[1..m] of real;
  i,index : integer;
  min,res : real;
begin
  for i:=1 to m do
  begin
	 write('x[',i,']=');
	 readln(x[i]);
  end;
  min:=1;
  for i:=1 to m do
  begin
	 if frac(x[i])>=0.5 then res:=1-frac(x[i])
	 else res:=1-(1-frac(x[i]));
	 if res<min then
	 begin
	  min:=res;
	  index:=i;
	 end;
  end;
  write('Output: ',x[index]:0:3);
  readln;
end.

5. Составить программу, выводящую на экран номера элементов массива, кратных четырем.

program Mod4;
const n=8;						 { Размерность массива }
var
  i   : byte;
  a   : array [1..n] of integer;
begin
  { Заполнение массива }
  for i:=1 to n do
  begin
	 write('a[',i,']=');
	 readln(a[i]);
  end;
  for i:=1 to n do
	 if a[i] mod 4 = 0 then write(i,' ');
  readln;
end.

6. Составить алгоритм и программу для сортировки массива по следующему принципу следования элементов: максимальный элемент, минимальный элемент, 2й по величине, предпоследний, 3й по величине, 3й с конца и т.д.

program Sort_Mas;
const n=8;						 { Размерность массива }
var
  i,j : byte;					 { Счетчики в циклах }
  imin: byte;					 { Индекс минимального элемента }
  k,c : integer;				  
  min : integer;				  { Минимальный элемент }
  a   : array [1..n] of integer;  
begin
  { Заполнение массива }
  for i:=1 to n do
  begin
	 write('a[',i,']=');
	 readln(a[i]);
  end;
  { Пузырьковая сортировка по возрастанию }
  for i:=2 to n do
	 for j:=n downto i do
	 begin
	  if a[j-1]>a[j] then
	  begin
		 c:=a[j-1];a[j-1]:=a[j];a[j]:=c;
	  end;
	 end;
  { Ставим максимальные элементы на нужные позиции }
  i:=1;k:=n;
  while k>(n div 2)+1 do
  begin
	 c:=a[i];
	 a[i]:=a[k];
	 a[k]:=c;
	 i:=i+2;
	 k:=k-1;
  end;
  { Ставим минимальные элементы на нужные позиции }   
  i:=2;k:=0;
  while k<(n div 2) do
  begin
	 min:=a[i-1];imin:=i-1;
	 for j:=i-1 to n do
	  if a[j]<min then begin min:=a[j];imin:=j;end;
	 c:=a[i];
	 a[i]:=a[imin];
	 a[imin]:=c;
	 i:=i+2;
	 k:=k+1;
  end;
  { Вывод отсортированного массива }
  for i:=1 to n do write(a[i],' ');
  readln;
end.

7. Задача: определить номер минимального элемента заданного одномерного массива.

uses crt;
const
  Len = 10
var
  mas: array[1 .. Len] of integer;
  min, n, i:integer;
begin
  { заполняем массив }
  randomize;
  for i:=1 to Len do mas[i]:=random(100);

  { собственно сортировка }
  min:=mas[1]; {начальный минимальный эл-т}
  n = 1
  for i := 2 to Len do begin {т.к. 1 элемент изначально взят за минимальный}
	if min > mas[i] then begin
	  min := mas[i];
	  n := i;
	end;
  end;

  { В n содержится номер минимального элемента }
end.

Список задач:

• 8. Даны 10 вещественых чисел. Определить наибольшее из отрицательных чисел, округлить его к ближайшему целому.
• 9. Ввести два вещественых числа a и b. Найти остаток от деления a и b. Определить принадлежность остатка интервалу [0 .. 4].
• 10. Вводятся различные целые числа. Надо определить четные и нечетные.
  Результат вывести на экран.
• 11. Нужно преобразовать матрицу, осуществив поворот элементов вокруг ее центра на 90 градусов против часовой стрелки.
• 12. Задать двумерный массив n*n. Посчитать число элементов бОльших, мЕньших, равных нулю. Вывести исходный массив элементов в виде таблицы и результаты вычислений.
• 13. Как расположить элементы отсортированной матрицы в ввиде "улитки"?

8. Даны 10 вещественых чисел. Определить наибольшее из отрицательных чисел, округлить его к ближайшему целому.

program desyat;
var
  a:array[1..10] of real;
  min:real;
  i:integer;
begin
  writeln('Ввести 10 чисел');
  for i:=1 to 10 do read(a[i]);
  min:=a[1];
  for i:=2 to 10 do
	if (min>a[i]) and (a[i]<0) then min:=a[i];
  writeln('Ответ: ',round(min));
end.

9. Ввести два вещественых числа a и b. Найти остаток от деления a и b. Определить принадлежность остатка интервалу [0 .. 4].

program dva;
var q,a,b,c:real;
begin
  writeln('Ввести A');
  readln(a);
  writeln('Ввести B');
  readln(B);
  c:=a/b;
  q:=a-(b*trunc( c ));
  if (q>=0) or (q<=4) then writeln('Принадлежит отрезку');
  writeln('Остаток: ',q:3:1);
end.

10. Вводятся различные целые числа. Надо определить четные и нечетные.
Результат вывести на экран.

Program by_Deadly;
Uses crt;
Var
  massiv:array[1..10] of longint;
  x:byte;
Begin
  for x:=1 to 10 do begin
	write('massiv[',x,']:=? ');
	readln(massiv[x]);
  end;
  ClrScr;
  for x:=1 to 10 do begin
	if odd(massiv[x])=true then
	  writeln('massiv[',x,']=',massiv[x],' - Нечетное число')
	else writeln('massiv[',x,']=',massiv[x],' - Четное число');
  end;
End.

11. Нужно преобразовать матрицу, осуществив поворот элементов вокруг ее центра на 90 градусов против часовой стрелки.

const n = 3;
var a, b : array[1..n, 1..n] of byte;
   i, j : integer;
begin
  { ввод матрицы }
  writeln('input your matrix ', n, ' x ', n);
  for i:=1 to n do for j:=1 to n do read(a[i,j]);

  { переворот }
  for i:=1 to n do
	for j:=1 to n do b[n-j+1,i]:=a[i,j];

  { вывод матрицы }
  writeLn;
  for i:=1 to n do begin
	for j:=1 to n do write(B[i,j],' ');
	writeln
  end;
end.

12. Задать двумерный массив n*n. Посчитать число элементов бОльших, мЕньших, равных нулю. Вывести исходный массив элементов в виде таблицы и результаты вычислений.

uses crt;
const
	n=10;
var
  mas:array[1..n,1..n] of integer;
  i,j,max,min,nol:integer;
begin
  randomize;
  clrscr;
  min:=0; max:=0; nol:=0;
  for i:=1 to n do begin
	for j:=1 to n do begin
	  mas[i,j]:=random(20)-10;
	  if mas[i,j]>0 then max:=max+1
	  else
		if mas[i,j]<0 then min:=min+1
		else nol:=nol+1;
	  write(mas[i,j],'|');
	end;
	writeln;
  end;

  writeln;
  writeln('bolshe 0 - ',max);
  writeln('menshe 0 - ',min);
  writeln('ravnih 0 - ',nol);
end.

13. Как расположить элементы отсортированной матрицы в ввиде "улитки"?

const m = 5;
var a: array[1..m, 1..m] of integer;
   i, j, di, dj, n  : integer;
   min_i, min_j, max_i, max_j : integer;
begin
  i:=1; j:=m; dj:=-1; di:=0;
  A[i,j]:=1;

  min_i:=2; min_j:=1;
  max_i:=m; max_j:=m;

  for n:=2 to m*m do begin
	{1}
	if (dj<>0) and (j+dj < min_j) then begin
	  dj:=0; di:=1; inc(min_j)
	end else

	{2}
	if (di<>0) and (i+di > max_i) then begin
	  di:=0; dj:=1; dec(max_i)
	end else

	{3}
	if (dj<>0) and (j+dj > max_j) then begin
	  dj:=0; di:=-1; dec(max_j)
	end else

	{4}
	if (di<>0) and (i+di < min_i) then begin
	  di:=0; dj:=-1; inc(min_i)
	end;

	inc(i, di); inc(j, dj);
	A[i,j]:=n
  end;
end.

Разбор задач:

• 14. Даны натуральное число N и последовательность A1, A2, ... An, состоящая из N целых чисел. Получить последовательность, которая отличается от исходной тем, что все нечетные элементы удвоены. Оба массива вывести на экран.
• 15. Даны натуральное число N и последовательность A1, A2, ... An. Определить количество вхождений N в данную последовательность (N – вводится с клавиатуры).
• 16. Даны натуральное число N и последовательность A1, A2, ... An. Определить наименьшее положительное среди A1, A2, ... An и найти сумму отрицательных.
• 17. Дана последовательность из 50 чисел. Найти их среднее арифметическое. Найти сколько среди них отличных от последнего числа.
• 18. Дана последовательность из N вещественных чисел. Вычислить сумму тех элементов последовательности, номера которых совпадают со значениями элементов последовательности.
• 19. Дана последовательность из N вещественных чисел. Все элементы последовательности с четными номерами, предшествующие первому по порядку элементу с наибольшим значением, домножить на него.
• 20. Дана последовательность из N вещественных чисел. Найти номер первого вхождения данного числа в последовательность или вывести сообщение, что такого числа нет.

14. Даны натуральное число N и последовательность A1, A2, ... An, состоящая из N целых чисел. Получить последовательность, которая отличается от исходной тем, что все нечетные элементы удвоены. Оба массива вывести на экран.

program N1; 
const n=10; 
var 
   i:integer; 
   a:array[1..n] of integer; 
begin 
   for i:=1 to n do begin
	 a[i]:=random(9)+1;write(a[i],'  ');
   end;

   writeln; 
   for i:=1 to n do begin 
	 if a[i] mod 2<>0 then a[i]:=a[i]*2;
	 write(a[i],'  '); 
   end; 
   readln; 
end.

15. Даны натуральное число N и последовательность A1, A2, ... An. Определить количество вхождений N в данную последовательность (N – вводится с клавиатуры).

program N2; 
var 
   i,n,k:integer; 
   a:array[1..100] of integer; 
begin 
   write('Input n  (n<=100) -> ');readln(n); 
   k:=0; 
   for i:=1 to n do begin
	 write('-> '); readln(a[i]);
	 if a[i]=n then k:=k+1;
   end; 
   write(k); 
   readln; 
end.

16. Даны натуральное число N и последовательность A1, A2, ... An. Определить наименьшее положительное среди A1, A2, ... An и найти сумму отрицательных.

program N3; 
const n=10; 
var 
   i,min,S:integer; 
   a:array[1..n] of integer; 
begin 
   S:=0; 
   for i:=1 to n do begin
	 a[i]:=random(10)-5;
	 write(a[i],'  ');
   end; 
   min:=32767; 
   for i:=1 to n do begin
	 if a[i]>0 then
	   if a[i]<min then min:=a[i]; 
	 if a[i]<0 then S:=S+a[i]; 
   end; 
   writeln; 
   writeln('Min pol -> ',min); 
   writeln('Summ otriz -> ',S); 
   readln; 
end.

17. Дана последовательность из 50 чисел. Найти их среднее арифметическое. Найти сколько среди них отличных от последнего числа

program N4; 
uses crt; 
const n=10; 
var a:array[1..n] of integer; 
	i,S,k:integer; 
begin 
   ClrScr; 
   S:=0; k:=0; 
   for i:=1 to n do begin 
	 a[i]:=random(10)+1;
	 write('  ',a[i]);
	 S:=S+a[i]; 
   end; 

   for i:=1 to n-1 do
	 if a[i]<>a[n] then k:=k+1; 
   writeln; 
   writeln('Sred arifmet: ',(S/n):0:2); 
   writeln('Otl ot Poslednego: ',k); 
   readln; 
end.

18. Дана последовательность из N вещественных чисел. Вычислить сумму тех элементов последовательности, номера которых совпадают со значениями элементов последовательности.

program N5;
const n=10; 
var 
	i,k:integer; 
	a:array[1..n] of real; 
begin 
   k:=0; 
   for i:=1 to n do begin
	 write('-> '); readln(a[i]);
   end;

   for i:=1 to n do
	 if a[i]=i then k:=k+1;
   write('Otvet: ',k); 
   readln; 
end.

19. Дана последовательность из N вещественных чисел. Все элементы последовательности с четными номерами, предшествующие первому по порядку элементу с наибольшим значением, домножить на него.

program N6; 
const n=10; 
var 
   a:array[1..n] of real; 
   i,k:integer; 
   max:real; 
begin 
   for i:=1 to n do begin 
	 a[i]:=random(9)+1;
	 write(a[i]:3 :1,' ');
   end;

   for i:=1 to n do
	 if a[i]>max then begin
	   max:=a[i];k:=i;
	 end;

   for i:=1 to k-1 do
	 if i mod 2=0 then a[i]:=a[i]*max; 
   writeln; 
   for i:=1 to n do write(a[i]:3 :1,' '); 
   readln; 
end.

20. Дана последовательность из N вещественных чисел. Найти номер первого вхождения данного числа в последовательность или вывести сообщение, что такого числа нет.

program N7; 
const n=10; 
var 
   a:array[1..n] of real; 
   i,k:integer; 
   r:real; 
begin 
   k:=0; 
   write('Input r -> ');readln( r ); 
   for i:=1 to n do begin
	 write('-> '); readln(a[i]); 
   end;

   for i:=1 to n do
	 if a[i]=r then begin
	   k:=i; break;
	 end;

   if k=0 then writeln('Net!') 
   else writeln('N: ',k); 
   readln; 
end. 

Разбор задач:

• 20. Дан лабиринт (матрица), который проограмма должна пройти,с ввыводом результата.
• 21. Имеется шахматная доска. Конь должен столько ходов, чтобы побывать на всех клетках доски.
• 22.Расположить 8 ферзей на шахматной доске так, чтобы они не находились друг у друга «под боем».

20. Дан лабиринт (матрица), который проограмма должна пройти,с ввыводом результата.

const n=12;
type
 matr = array [1..n] of string;
const mat: matr =   ('############',
		     '#...#......#',
		     '..#.#.####.#',
		     '###.#....#.#',
		     '#....###.#..',
		     '####.#.#.#.#',
		     '#..#.#.#.#.#',
		     '##.#.#.#.#.#',
		     '#........#.#',
		     '######.###.#',
		     '#......#...#',
		     '############');
var
m: matr;
i: integer;

function step(var m: matr;x,y: integer): boolean;
begin
  if m[x][y]<>'.' then begin
   step := false; exit; end;
 if y=1 then begin
 step := true; m[x][y]:='X'; exit; end;
 m[x][y]:='X';
 if step(m,x+1,y) then begin step := true; exit; end;
 if step(m,x,y+1) then begin step := true; exit; end;
 if step(m,x-1,y) then begin step := true; exit; end;
 if step(m,x,y-1) then begin step := true; exit; end;
 m[x][y]:='.';
 step := false;
end;

begin
 m := mat;
 step(m,5,n);
 for i:= 1 to n do
  writeln(m[i]);
readln;
end.

21. Имеется шахматная доска. Конь должен столько ходов, чтобы побывать на всех клетках доски.

const n=5;
var
desk: array [0..n,0..n] of integer;
nstep: integer;

function step(x,y,nstep: integer): boolean;
const xy: array [1..8,1..2] of integer = ((1,-2),(1, 2),(-1,-2),(-1, 2),(2,-1),(2, 1),(-2, 1),(-2,-1));
var i: byte;
begin
 if (nstep = n*n) then begin step:=true; exit; end;
 if (x < 0) or (x >= n) or (y < 0) or (y >= n) then begin
  step:= false; exit;
 end;
 if (desk[x,y] <> 0) then begin step := false; exit; end;
 desk[x,y] := nstep+1;
 for i:= 1 to 8 do
 if (step(x+xy[i,1], y+xy[i,2],nstep+1)) then begin
  step := true; exit;
 end;
 desk[x,y] := 0;
 step := false;
end;

begin
 writeln(step(0,0,nstep));
 readln;
end.

22.Расположить 8 ферзей на шахматной доске так, чтобы они не находились друг у друга «под боем».

var
r: array [0..8] of integer;
int: integer;

function test(i: integer): boolean;
var j: integer;
begin
for j:= i-1 downto 0 do begin
 if R[i]=R[j] then begin test:=false; exit; end;
 if abs(R[i]-R[j])=i-j then test:= false;
end;
end;

function step(i: integer): boolean;
var j: integer;
begin
if i=8 then begin step:=true; exit; end;
for j:= 0 to 7 do begin
 r[i]:=j;
 if not test(i) then continue;
 if step(i+1) then begin step:=true; exit; end;
end;
step:=false;
end;

begin
 step(0);
 for int:= 0 to 7 do
  writeln(r[int]);
readln;
end.