Программы. Program P1 var i byte begin

Название	Program P1 var i byte begin
Дата	19.03.2018
Размер	50.7 Kb.
Формат файла
Имя файла	Программы.docx
Тип	Документы #38863

Организация вывода данных

по требуемому формату

5.1. Напечатать ряд чисел 20 в виде: 20 20 20 20 20 20 20 20 20 20.

Program P1;

var i: byte;

begin

for I:=1 to 10 do write(20,' ');

readln;

end.

5.2. Составить программу вывода любого числа любое заданное число раз в виде, аналогичном показанному в предыдущей задаче.

Program MZ2;

var a,n,i:integer;

begin

write(‘Введите число a=');

read(a);

write(‘Сколько раз вывести n=');

read(n);

for i:=1 to n do write(a,' ');

end.

5.3. Напечатать "столбиком":

а) все целые числа от 20 до 35;

Program MZ11;

var i: integer;

begin

for i:=20 to 35 do writeln (i);

end.

б) квадраты всех целых чисел от 10 до b (значение b вводится с клавиатуры; b больше или равно 10);

Program MZ12;

var i,a: integer;

begin

read (a);

for i:=a to 50 do writeln (i*i);

end.

в) третьи степени всех целых чисел от a до 50 (значение a вводится с клавиатуры; a меньше или равно 50);

Program MZ13;

var i,a: integer;

begin

read (a);

for i:=a to 50 do writeln (i*i*i);

end.

г) все целые числа от a до b (значения a и b вводятся с клавиатуры; b больше или равно a).

Program MZ14;

var i,b,a: integer;

begin

read (a, b);

for i:=a to b do writeln (i);

end.

Обработка фиксированной

последовательности чисел

5.27. Найти: а) сумму всех целых чисел от 100 до 500;

Program MZ17;

var

sum, i: integer;

begin

sum := 0;

for i := 100 to 500 do

sum := sum + i;

writeln(sum);

end.

б) сумму всех целых чисел от a до 500 (значение a вводится с клавиатуры;a 500);

Program MZ18;

Var i, a, s: integer;

begin

readln(a);

for i := a to 500 do

s := s + i;

writeln(s);

end.

в) сумму всех целых чисел от –10 до b (значение b вводится с клавиатуры;b –10);

Program MZ19;

var b,i,s:integer;

begin

s:=0;

read (b);

if (b>-10) then

begin

for i:=-10 to b do

begin

s:=s+i;

end;

end;

writeln (s);

end.

г) сумму всех целых чисел от a до b (значения a и b вводятся с клавиатуры;b a).

Program MZ20;

uses crt;

var a,b,s,i:integer;

begin

clrscr;

readln(a);

readln(b);

for i:=a to b do

begin

s:=s+i;

end;

writeln(s);

readln;

end.

5.28. Найти: а) произведение всех целых чисел от 8 до 15;

Program MZ21;

Var i:integer;

p:longint;

Begin

p:=1;

For i:=8 to 15 do

p:=p*i;

writeln('Proizvedenie: ',p);

End.

б) произведение всех целых чисел от a до 20 (значение a вводится с клавиату- ры; 1 a 20);

Program k1;

uses crt;

const n=20;

Var a,i,p:integer;

begin

clrscr;

writeln('Vvedite a bolyshe 1 i menishe 20 = ');

readln(a);

P:=1;

for i:=a to n do begin

P:=p*i;

end;

writeln('Proizvedenie ravno = ',p);

readln;

End.

в) произведение всех целых чисел от 1 до b (значение b вводится с клавиату- ры; 1 b 20);

г) произведение всех целых чисел от a до b (значения a и b вводятся с клавиатуры; b a).

Program MZ23;

var

a,b,i,p:integer;

begin

write('Vv A: ')

;readln(a);

write('Vv B: ');readln(b);

p:=1;

for i:=a to b do

p:=p*i;

writeln('Proizvedenie tcelih ot A do B= ',p);

end.

5.29. Найти: а) среднее арифметическое всех целых чисел от 1 до 1000;

program mz24;

var i,n:integer;

s:real;

begin

n:=1000;

i:=1;

while (i<=n) do

begin

s:=s+i;

inc(i);

end;

s:=s/(n+i);

writeln (s);

end.

б) среднее арифметическое всех целых чисел от 100 до b (значение b вводится с клавиатуры; b 100);

program z;

var s,k,b,i:integer; sa:real;

begin

writeln('VV trehznacinoe cislo');

readln(b);

s:=0; k:=0; sa:=0;

for i:=100 to b do

begin

s:=s+i;

k:=k+1;

end;

sa:=s/k;

writeln('Srednee arifm cisel ot 100 do ',b,' - ',sa);

end.

в) среднее арифметическое всех целых чисел от a до 200 (значения a и b вво- дятся с клавиатуры; a 200);

program mz15;

Var

a,i: Byte;

s: Integer;

BEGIN

Repeat

Write('VV A<=200: ');

Readln(a);

until a in [0..200];

For i:=a to 200 do

s:=s+i;

Writeln('Sredn arifm ot ',a,' do 200 = ',s/(200-a+1):2:2);

END.

г) среднее арифметическое всех целых чисел от a до b (значения a и b вводят- ся с клавиатуры; b a).

Обработка числовых последовательностей

6.1. Дана непустая последовательность целых чисел, оканчивающаяся нулем.

Найти:а) сумму всех чисел последовательности; б) количество всех чисел последовательности.

program posl;

var

i,count,s,num : integer;

a : array[1..1000] of integer;

begin

s:=0;

count:=0;

read(num);

while(num <> 0)

begin

count := count+1;

a[count] := num;

end;

for i=1 to count do

s := s+a[i];

writeln(count);

writeln(num);

end.

Использование условного оператора

в теле операторов цикла с условием

Дано натуральное число. Определить: а) количество цифр 3 в нем; б) сколько раз в нем встречается последняя цифра; в) количество четных цифр в нем. Составное условие и более одного неполного условного оператора не использовать; г) сумму его цифр, больших пяти; д) произведение его цифр, больших семи; е) сколько раз в нем встречаются цифры 0 и 5 (всего).

Program mz1;

var
o:array[1..6] of int64;
n:int64;
i,ln:integer;
begin
write('Введите число:');readln(n);
ln:=n mod 10;
repeat
i:=n mod 10;
n:=n div 10;
if i=3 then inc(o[1]);
if i>5 then inc(o[4],i);
if i>7 then if o[5]=0 then o[5]:=i else o[5]:=o[5]*i;
if i in [0,5] then inc(o[6]);
if i=ln then inc(o[2]);
if i mod 2=0 then inc(o[3]);
until n=0;
writeln('количество цифр 3 в нем:',o[1]);
writeln('сколько раз в нем встречается последняя цифра:',o[2]-1);
writeln('количество четных цифр в нем:',o[3]);
writeln('сумму его цифр, больших пяти:',o[4]);
writeln('произведение его цифр, больших семи:',o[5]);
writeln('сколько раз в нем встречаются цифры 0 и 5:',o[6]);
readln;
end.

Использование условного оператора

после операторов цикла с условием

Дано натуральное число. а) Верно ли, что сумма его цифр больше 10?

var

a, sum : integer;

begin

read (a);

sum := 0;

while (sum <= 10) and (a > 0) do

begin

sum := sum + a mod 10;

a := a div 10;

end;

if sum > 10 then write ('Yes') else write ('No');

end.

б) Верно ли, что произведение его цифр меньше 50?

в) Верно ли, что количество его цифр есть четное число?

Program mz2;

Var i,n,k,b: integer;

begin

write(' b = '); readln(b);

write(' n = '); readln(n);

i:=n; k:=0;

while i>0 do

begin

i:=i div 10; k:=k+1;

end;

if n<=b then writeln('число n не превышает ',b)

else writeln('число n больше ',b);

if (k mod 2) = 0 then writeln('число цифр = ',k,' - четное')

else writeln('число цифр ',k,' - нечетное');

end.

г) Верно ли, что это число четырехзначное? Составное условие и вложенный условный оператор не использовать.

Program mz3;
uses crt;
var m, n: longint;
k: integer;
begin
clrscr;
writeln('Введите N='); readln(n);
m:=n;k:=0;
while m <>0 do
begin
k:=k+1;
m:= m div 10;
end;
case k of
4:writeln('число четырехзначное') else writeln('не 4-х значное число');
end;
end.

д) Верно ли, что его первая цифра не превышает 6?

program mz4;

const

nmax=6;

var

a:longint;

begin

write('vvedite chislo: ');

readln(a);

while a>10 do

a:=a div 10;

if a<=6 then writeln('verno, pervaya cifra: ',a)

else writeln('neverno, pervaya cifra: ',a);

readln;

end.

е) Верно ли, что оно начинается и заканчивается одной и той же цифрой?

Program mz15;
var n,a,b:integer;
begin
read(n);
a:=n;
if n<10 then
writeln('это однозначное число')
else
begin
b:=n mod 10;
repeat
a:=a div 10;
until a<10;
if b = a then
writeln('первая и последняя цифры одинаковы')
else writeln('первая и последняя цифры различны');
end;
readln;
end.

ж) Определить, какая из его цифр больше: первая или последняя.

Program mz6;

var
N, l: integer;

begin
readln(N);
l := N mod 10;
while N > 10 do
N := N div 10;
if l > N then
write('Последняя')
else if l < N then
write('Первая')
else
write('Они равны');
readln;
end.

Использование условного оператора в теле

операторов цикла с условием и после него

6.80. Дано натуральное число. Определить, какая цифра встречается в нем чаще: 0 или 9.

program mz7;
var
Varn, nine, one, n: integer;
begin
readln(n);
nine := 0;
one := 0;
while (n > 0) do
begin
if (n mod 10 = 0) then
inc(one)
else
if (n mod 10 = 9) then
inc(nine);n := n div 10;
end;
if (one = nine) then
writeln('Равны')
else
if (one > nine) then
writeln('Нулей больше')
else
writeln('Девяток больше');
end.

Инициализация массива

и вывод его на экран

11.6. Заполнить массив из двенадцати элементов так, как показано на рис. 11.1.

…

program mz1;

uses crt;

var a: array [1..12] of integer;

i:integer;

begin

clrscr;

a[1]:=1;

a[2]:=2;

a[3]:=3;

a[4]:=4;

a[5]:=5;

a[6]:=6;

a[7]:=7;

a[8]:=8;

a[9]:=9;

a[10]:=10;

a[11]:=11;

a[12]:=12;

for i:=1 to 12 do

write (a[i],' ');

readln

end.

Обработка элементов массива

11.15. Дан массив. Составить программу: а) расчета квадратного корня из любого элемента массива; б) расчета среднего арифметического двух любых элементов массива.

Program mz4;

Var
x: Array [1..100] of Integer;
i,n,a,b: Byte;
begin
Write('Введите количество элементов: ');
Readln(n);
Writeln('Массив: ');
For i:=1 to n do
begin
x[i]:=Random(100);
Write(x[i],' ');
end;
Writeln;
a:=Random(n)+1;
Writeln('Квадратный корень ',a,'-го элемента = ',Sqr(x[a]));
a:=Random(n)+1;
b:=Random(n)+1;
Writeln('Ср. арифм ',a,'-го и ',b,'-го элементов = ',(x[a]+x[b])/2:2:2);
end.

Использование условий для изменения

элементов массива и вывода их на экран

11.36. Дан массив. Напечатать: а) все неотрицательные элементы; б) все элементы, не превышающие число 100.

var

a:array[1..5]of integer;

i:byte;

begin

for i:=1 to 5 do

readln(a[i]);

writeln();

for i:=1 to 5 do

if (a[i]>0) then

writeln(a[i]);

for i:=1 to 5 do

if (a[i]<100) then

writeln(a[i]);

end.

Расчет суммы или количества

элементов массива, удовлетворяющих

некоторому условию

11.54. Дан массив. Найти: а) сумму элементов массива, значение которых не превышает 20;

const N=10;

var a:array[1..N] of integer;

Procedure Initmas;

var i:integer;

begin

Randomize;

for i:=1 to N do

begin

a[i]:=random(40)-5;

write(a[i]:4);

end;

writeln;

end;

var i,Sum:integer;

begin

sum:=0;

writeln('Massiv: ');

Initmas;

for i:=1 to N do

if a[i]<20 then Sum:=Sum+a[i];

writeln('Sum>20= ',sum);

readln;

end.

б) сумму элементов массива, больших числа a.

const

n=10;

var

arr: array[1..100] of integer;

i, summ, a: integer;

begin

summ:=0;

readln(a);

for i:=1 to n do

begin

read(arr[i]);

if arr[i]>a then

inc(summ);

end;

writeln;

write(summ);

end.

Поиск максимума и минимума

11.107. Дан массив. Определить: а) максимальный элемент; б) минимальный элемент; в) на сколько максимальный элемент больше минимального; г) индекс максимального элемента; д) индекс минимального и индекс максимального элементов.

uses crt;

var a:array[1..10] of integer;

i,max,min,n,m:integer;

begin

clrscr;

randomize;

for i:=1 to 10 do

begin

a[i]:=random(10);

write(a[i],' ');

end;

writeln;

max:=a[1];

min:=a[1];

for i:=1 to 10 do

begin

if a[i]

if a[i]>max then begin max:=a[i]; m:=i; end;

end;

writeln('max= ',max);

writeln('min= ',min);

writeln('max > min na ',max-min);

writeln('max nahoditsja v ',m,' jacheike massiva');

writeln('min nahoditsja v ',n,' jacheike massiva');

readkey;

end.

Изменение исходного массива

11.144. Дан массив. Поменять местами: а) второй и пятый элементы;

program name;

const

n=10 ;

var

a,b,j:integer;

mas:array [1..n] of integer;

begin

for j:=1 to n do begin

writeln ('vvesti ', j, 'element massiva');

readln (mas[j]);

end;

a:=mas[2] ;

b:=mas[5] ;

readln;

mas[5]:=a;

mas[2]:=b ;

end.

б) m-й и n-й элементы;

program name;

uses crt;

var

a,b,j,x:integer;

m,n:integer;

mas:array [1..100] of integer;

begin

writeln ('vvesti kol element massiva');

read(x);

for j:=1 to x do begin

write ('vvesti ', j, ' element massiva: ');

readln (mas[j]);

end;

writeln ('vvesti noera elementov dlea obmena');

readln (m,n);

for j:=1 to x do begin

if j=m then begin

a:=mas[j] ;

mas[m]:=mas[n] ;

mas[n]:=a; end;

readln;

end;

for j:=1 to x do begin writeln (mas[j]); end;

end.

в) третий и максимальный элементы. Если элементов с максимальным значением несколько, то в обмене должен участвовать первый из них; г) первый и минимальный элементы. Если элементов с минимальным значением несколько, то в обмене должен участвовать последний из них.

Домашняя работа:

Полный условный оператор

4.19.*Даны два прямоугольника, стороны которых параллельны или перпендикулярны осям координат. Известны координаты левого нижнего угла каждого из них и длины их сторон. Найти координаты левого нижнего и правого верхнего углов минимального прямоугольника, содержащего указанные прямоугольники.

Левый нижний

1 if x1

2 if y1>y3 then y5:=y1 else y5:=y3;

Правый верхний

1 if x2>x4 then x6:=x2 else x6:=x4;

2 if y2

4.57. Дано трехзначное число. Определить: а) входит ли в него цифра 6;

Program P1;
Var n : Word;

Begin
Write('Введи число: ');
Readln(n);

Write((n mod 10 = 4) or (n div 10 mod 10 = 4) or (n div 100 = 4));

Readln;
End.

4.97.Даны три различных целых числа. Определить, какое из них (первое, второе или третье): а) самое большое; б) самое маленькое; в) является средним (средним назовем число, которое больше наименьшего из данных чисел, но меньше наибольшего).

Program mz15;
var
a,b,c:integer;
begin
writeln('первое число:');
readln(a);
writeln('второе число:');
readln(b);
writeln('третие число:');
readln(c);
if (a>b) and (a>c) then
writeln('Первое число является наибольшим');
if (a>b) and (ac) then
writeln('Первое число является средним');
if (a
writeln('Первое число является наимешим');
if (b>a) and (b>c) then
writeln('Второе число является наибольшим');
if (b>a) and (bc) then
writeln('Второе число является средним');
if (b
writeln('Второе число является наимешим');
if (c>b) and (c>a) then
writeln('Третие число является наибольшим');
if (c>b) and (ca) then
writeln('Третие число является средним');
if (c
writeln('Третие число является наимешим');
end.

5.18. Рассчитать значения z для значений a, равных 2, 3, ..., 17:

z = 3.5t²– 7t + 16,

t = 4a.

Program mz818;
var
a, t: integer;
z: real;
begin
a := 2;
repeat
t := 4 * a;
z := 3.5 * (exp(ln(t) * 2)) - 7 * t + 16;
inc(a);
Writeln(z);
until a = 17;
end.

5.49. Даны натуральное число n и вещественные числа a_1,a₁..., a_n. Определить сумму квадратов вещественных чисел.

Program mz776;
Var
i,n:integer;
s,t:real;
begin
Write('n='); Readln(n);
s:=0;
for i:=1 to n do begin
Read(t);
s:=s+t*t
end;
Writeln('Сумма квадратов равна ',s)
end.