Новости :

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

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

Материал подготовил(и): AlaRic

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

CODE
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 элементов. Написать процедуру для определения числа тех строк массива, которые не содержат чисел из первой строки.

CODE
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). Подсчитать и вывести на экран общее количество отрицательных элементов, определить в какой из матриц среднее арифметическое значение прочих элементов имеет большую величину.

CODE
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) найти элемент массива, значение которого наиболее близко к какому нибудь целому числу.

CODE
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 begin
min:=res;
index:=i;
end;
end;
write('Output: ',x[index]:0:3);
readln;
end.


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

CODE
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й с конца и т.д.

CODE
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] 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. Задача: определить номер минимального элемента заданного одномерного массива.

CODE
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]; {начальный минимальный эл-т}
for i := 1 to Len do begin
if min min:=mas[i];
n:=i;
end;
end;

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


Материал подготовил(и): AlaRic

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

CODE
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].

CODE
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. Вводятся различные целые числа. Надо определить четные и нечетные.
Результат вывести на экран.

CODE
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 градусов против часовой стрелки.

CODE
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. Посчитать число элементов бОльших, мЕньших, равных нулю. Вывести исходный массив элементов в виде таблицы и результаты вычислений.

CODE
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. Как расположить элементы отсортированной матрицы в ввиде "улитки"?

CODE
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.


Материал подготовил(и): AlaRic

Разбор задач:
  • 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] 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.

Материал взят с сайта Всё о Паскале
Комментарии: (0) | Pascal & Delphi | 2006-06-01