Сумма цифр числа равна
К заданию 1
Program
Task1;
uses WinCrt;
var
a, e, d, s, t, s1, p : integer;
begin
write('Введите четырехзначное число '); readln(a);
e := a mod 10; a := a div 10;
d := a mod 10; a := a div 10;
s := a mod 10; t := a div 10;
s1 := e + d + s + t; {Сумма цифр}
p := e*d*s*t; {Произведение цифр}
writeln(' Сумма цифр числа равна ', s1);
writeln('Произведение цифр равно ', p)
end.
К заданию 2
Задача 2
Program Task2_2;{Определение большего из двух чисел}
uses WinCrt;
var
a, b, c : integer;
begin
write('Введите первое число '); readln(a);
write('Введите второе число '); readln(b);
if a = b then writeln('Числа равны')
else if a > b then writeln('Большее число ', a)
else
writeln('Большее число ', b)
end.
Задача 3
Program Task2_3;{Определение модуля числа}
uses WinCrt;
var
a : integer;
begin
write('Введите целое число '); readln(a);
if a >= 0 then writeln('Модуль числа ', a, ' равен ', a)
else writeln('Модуль числа ', a, ' равен ', -a)
end.
К заданию 3
Program
Task3; { Решение уравнения ax = b }
uses WinCrt;
var
a, b : real;
begin
write('Введите первый коэффициент '); readln(a);
write('Введите свободный член '); readln(b);
if
a <> 0 then writeln('Уравнение имеет одно решение ', b/a:6:3)
else if (a = 0) and (b <> 0)
then
writeln('Уравнение не имеет решений')
else writeln('Уравнение имеет б/м решений')
end.
К заданию 4
Program
Task4; { Входят ли четные цифры в запись трехзначного числа? }
uses WinCrt;
var
a, s, d, e : integer;
begin
write('Введите трехзначное число '); readln(a);
e := a mod 10; a := a div 10; d := a mod 10; s := a div 10;
if (s mod 2 = 0) or (d mod 2 = 0) or (e mod 2 = 0)
then writeln('Четные цифры входят в запись этого числа')
else writeln('Четные цифры не входят в запись числа')
end.
К заданию 2
Задача 2
1-й способ
Program Task2_2;
uses WinCrt;
var
n, p, n1 : longint;
begin
write('Введите натуральное число n '); readln(n);
n1 := 0;
while n > 0 do
begin
p := n mod 10;
n1 := n1*10 + p;
n := n div 10
end;
writeln('Число, после перестановки цифр ', n1 + n)
end.
2-й способ
Program Task2_2a;
uses WinCrt;
var
n, p, n1 : longint;
begin
write('Введите натуральное число '); readln(n);
n1 := 0;
while n > 0 do
begin
n1 := n1*10 + n mod 10;
n := n div 10
end;
writeln('Число, после перестановки цифр равно ', n1)
end.
К
заданию 3
Задача 2
Program Task3_2;
uses WinCrt;
var
n, a, p, b, s : integer;
begin
write(' Введите натуральное число меньшее 28 '); readln(a);
b := 100;
writeln('Трехзначные числа, сумма цифр которых');
write('равна числу ', a, ' следующие: ');
while b < 1000 do
begin
s := 0; n := b;
while n <> 0 do
begin
p := n mod 10;
s := s + p;
n := n div 10
end;
if s = a then write(b, ', ');
b := b + 1
end; writeln
end.
Задача 3
Program Task3_3;
uses WinCrt;
var
n, d, e : integer;
begin
n := 10;
write('Искомое двузначное число ');
while n <= 99 do
begin
d := n div 10; e := n mod 10;
if n + d*d*d + e*e*e = e*10 + d then
writeln(n);
n := n + 1
end
end.
К
заданию 4
Program Task4;
uses WinCrt;
var
n, a, p, b, s : integer;
begin
write('Введите натуральное число '); readln(a);
b := 1;
writeln('Натуральные числа, сумма цифр ');
write('которых равна числу ', a, ' следующие: ');
while b < 32767 do
begin
s := 0; n := b;
while n <> 0 do
begin
p := n mod 10; s := s + p; n := n div
10
end;
if s = a then write(b, ', ');
b := b + 1
end; writeln
end.
К
заданию 1
Program Task1;
uses WinCrt;
var
n, a, k : integer;
begin
n := 131;
repeat
n := n + 131;
a := n; k := 0;
repeat
k := k + 1;
a := a div 10
until a = 0;
until k mod 2 = 0;
writeln('Наименьшее натуральное число, кратное 131');
writeln(' с четным количеством цифр равно ', n)
end.
К
заданию 2
Program Task2_2;
uses WinCrt;
var
a, n, p, s : integer;
begin
a := 100;
writeln('Трехзначные числа, при делении которых на 11');
write('частное равно сумме квадратов их цифр следующие ');
repeat
n := a; s := 0;
repeat
p := n mod 10;
s := s + p*p;
n := n div 10
until n = 0;
if (a mod 11 = 0) and (s = a div
11) then write(a, '; ');
a := a + 1
until a = 1000;
end.
К заданию 4
Program
Task4; { НОК двух чисел. 1 - способ }
uses WinCrt;
var
a, b, m, n, p : integer;
begin
write('Введите первое число '); readln(a);
write('Введите второе число '); readln(b);
p := 0;
repeat
if a>b then
begin
m := a; n := b
end
else
begin
m := b; n := a
end;
p := p + m
until p mod n =0;
writeln('НОК чисел ', a, ' и ', b, ' равен ', p)
end.
К заданию 5
Program
Task5; { Является ли число простым? 2- способ }
uses WinCrt;
label 1, 2;
var
n, i : integer;
begin
write('Введите целое число '); readln(n);
i := 3;
if n = 2 then writeln('Число ', n, ' - простое')
else if n = 3
then writeln('Число ', n, ' - простое')
else
if n mod 2 = 0 then
writeln('Число ',n,' составное')
else
repeat
if
n mod i = 0 then goto 1;
i := i + 2
until
i > n div 2;
writeln('Число ', n, ' простое'); goto 2;
1: writeln('Число ', n, ' составное');
2: end.
К заданию 1
Program
Task1;
uses WinCrt;
var
n, s, s1 : integer;
{----------------------------------------------------------------------------------------}
Procedure extent(a, n : integer; var s : integer);
var
i : integer;
begin
i := 1; s := 1;
repeat
s := s*a; i := i + 1
until i = n
end;
{----------------------------------------------------------------------------------------}
begin
n := 1;
repeat
n := n + 1;
extent(2, n, s);
extent(3, n, s1);
until ((s - 2) mod (n - 1) <> 0) and
((s1 - 3) mod (n - 1) = 0);
writeln(' Искомое число равно ', n - 1)
end.
К
заданию 2
Program Task2;
uses WinCrt;
var
n, s, s1 : integer;
{----------------------------------------------------------------------------------------}
Procedure extent(a, n : integer; var s : integer);
var
i : integer;
begin
i := 1;
s := 1;
repeat
s := s*a;
i := i+1
until i=n
end;
{----------------------------------------------------------------------------------------}
begin
n := 1;
repeat
n := n+1;
extent(2, n, s);
extent(3, n, s1);
until ((s-2) mod (n-1)<>0) and
((s1-3) mod (n-1)=0);
writeln('Искомое число равно ', n-1)
end.
К заданию 3
Program Task3; { Сумма правильных делителей }
uses WinCrt;
var
i, a, b, s : integer;
{----------------------------------------------------------------------------------------}
Procedure math_divisor(n : integer; var s : integer);
var
d : integer;
begin
s := 0;
for d := 1 to n div 2 do
if n mod d = 0 then s := s + d
end;
{----------------------------------------------------------------------------------------}
К заданию 1
К примеру 1
Program Task1;
uses WinCrt;
var
p : longint;
{----------------------------------------------------------------------------------------}
Procedure placement(n, k : integer; var r : longint);
var
i : integer;
begin
r := 1;
for i := 1 to k do r := r*(n - k + i)
end;
{----------------------------------------------------------------------------------------}
begin
placement(40, 3, p);
writeln('Число различных способов равно ', p)
end.
К
примеру 2
Program Task1_2;
uses WinCrt;
var
s, r1, r2, r3 : longint;
{----------------------------------------------------------------------------------------}
Procedure placement(n, k : integer; var r : longint);
var
i : integer;
begin
r := 1;
for i := 1 to k do r := r*(n - k + i)
end;
{----------------------------------------------------------------------------------------}
begin
placement(5, 1, r1);
placement(5, 2, r2);
placement(5, 3, r3);
s := r1 + r2 + r3;
writeln(' Не более чем трехзнач. чисел можно составить');
writeln('из цифр 1, 2, 3, 4, 5; ', s, ' способами')
end.
К заданию 2
К примеру 1
Program Task2_1;
uses WinCrt;
var
p1, p2, p : longint;
m, n : integer;
{----------------------------------------------------------------------------------------}
Procedure placement(n, k : integer; var r : longint);
var
i : integer;
begin
r := 1;
for i := 1 to k do r := r*(n - k + i)
end;
{----------------------------------------------------------------------------------------}
begin
write('Введите число всех элементов '); readln(m);
write('Введите число выбираемых элементов '); readln(n);
placement(m, n, p1);
