 
|
1. , :
Procedure sum_number(n : integer; var
s : integer);
begin
s := 0;
repeat
s := s + n mod 10;
n := n div 10
until n = 0
end;
Procedure sum_number(p : longint; var s : longint);
begin
s := 0;
while p <> 0 do
begin
s := s + p mod 10;
p := p div 10
end
end;
2. , :
Procedure quantity_number(n : integer; var
k : integer);
begin
k := 0;
repeat
k := k + 1;
n := n div 10
until n = 0
end;
3. , , , 3467 : 7643.
Procedure backwards(n : integer; var
a : integer);
begin
a := 0;
repeat
a := a*10 + n mod 10;
n := n div 10
until n = 0
end;
4. .
Procedure first_last_number(n : integer; var n1 : integer);
var
a, i, p : integer;
begin
a := n; i := 1;
p := n mod 10; { }
while n >= 10 do
begin
i := i*10;
n := n div 10
end;
n1 := a - n*i - p + n + p*i
end;
5. , , - .
Procedure palindrom(a : integer);
var
b, c, p : integer;
begin
b := a; c := 0;
repeat
p := b mod 10;
c := c*10 + p;
b := b div 10
until b = 0;
if c = a then writeln(' ', a, ' ')
else writeln(' ', a, ' .
29. n k .
Procedure placement(n, k : integer; var
r : longint);
var
i : integer;
begin
r := 1;
for i := 1 to k do r := r*(n - i + 1)
end;
30. n k .
Procedure Combination(n, k : integer; var c : longint);
var
i : longint;
begin
c := 1;
for i := 1 to k do
c := c*(n - k + i) div i
end;
41. .
Function t(eps : real) : integer;
var
k : integer;
begin
k := -1;
repeat
eps := eps*10;
k := k + 1
until eps > 1;
t := k
end;
42. .
1-
Procedure square_root(u, eps : real; var
x : real);
begin
x := (u + 1)/2;
repeat
x := (1/2)*(x + u/x)
until abs(x*x - u) <= eps;
end;
2-
Procedure square_root(u, eps : real; var
x : real);
var
x1, x2 : real;
begin
x1 := 1;
repeat
x1 := (1/2)*(x1 + u/x1);
x2 := (1/2)*(x1 + u/x1)
until abs(x2 - x1) <= eps;
x := x2
end;
167.
a1, a2, ..., b.
168.
a1, a2, ... .
169. n , n- . ( ).
)
)
)
170. , n
, n- . ( ).
)
)
)
171.
.
172. n. :
173. u0, u1, ... :
')
end;
6. .
, .. , .
Procedure radical_number(n : integer; var
k : integer);
var
p, s : integer;
begin
repeat
s := 0;
while n <> 0 do
begin
p := n mod 10; s := s+p; n := n div
10
end;
n := s
until n < 10;
k := n
end;
7. :
1- ( )
Procedure nod1(a, b : integer; var
n : integer);
begin
if a > b then n := b else n := a;
n := n + 1;
repeat
n := n - 1
until (a mod n = 0) and (b mod
n = 0)
end;
2- ( 1- )
Procedure nod2(a, b : integer; var
n : integer);
begin
while a <> b do
begin
if a > b then a := a - b else
b := b - a
end;
n := a
end;
3- ( 2- )
Procedure nod(a, b : integer; var
n : integer);
var
r : integer;
begin
repeat
r := a mod b;
a := b; b := r
until b = 0;
n := a
end;
8. .
Procedure nod(a, b : integer; var
n : integer);
begin
if b = 0 then n := a else nod(b, a mod
b, n)
end;
9. ().
1-
Procedure nok(a, b : integer; var
k : integer);
var
m, n : integer;
begin
k := 0;
repeat
if a > b then
begin
m := a; n := b
end
else
begin
m := b; n := a
end;
k := p + m
until k mod n = 0
end;
2- ( ).
Procedure nok1(a, b : integer; var
k : integer);
var
n : integer;
begin
n := a*b;
repeat
c := a mod b;
a := b; b := c
until b = 0;
k := n div a
end;
10. .
1-
Procedure everyone_divisor(n : integer);
var
i : integer;
begin
writeln(' ', n);
for i := 1 to n div 2 do
if n mod i = 0 then write(i, ' ');
writeln(n)
end;
2-
Procedure everyone_divisor(n : integer);
var
i : integer;
begin
writeln(' ', n);
for i := 1 to trunc(sqrt(n)) do
if n mod i = 0 then write(i, ' ', n div i, ' ')
end;
11. , :
Procedure number_division(n : integer; var k : integer);
var
d : integer;
begin
k := 0;
for d := 1 to n div 2 do
if n mod d = 0 then k := k + 1;
k := k + 1
end;
12. :
Procedure probleme_number(n : integer);
var
i : integer;
begin
while n mod 2 = 0 do
begin
write(2, ' ');
n := n div 2
end;
i := 3;
while i <= n do
if n mod i = 0 then
begin
write(i, ' ');
n := n div i
end
else
i := i + 2
end;
13. , , .
Procedure probleme_number(p : integer);
var
i, k : integer;
begin
if p = 2 then write(p, ' ')
else
if p mod 2 <> 0
then
begin
i := 3; k := 0;
while i <= p div
2 do
begin
if p mod i = 0 then k := k + 1;
i := i + 2
end;
if k = 0 then
write(p, ' ')
end
end;
Procedure probleme_number(p : integer);
var
i, k : integer;
begin
if p = 2 then write(p, ' ')
else if p mod 2 <> 0
then
begin
i := 3; k := 0;
while i <= trunc(sqrt(p)) do
begin
if p mod
i = 0 then k := k + 1;
i := i + 2
end;
if k = 0 then
write(p, ' ')
end
end;
14. , , ? , .
: 52 = 25; 252 = 625.
Procedura awtomorf(x : integer);
var
d, k : integer;
begin
d := 10;
while d <= x do d := d*10;
k := x mod 10;
if (k = 1) or (k = 5) or (k = 6)
then
if x*x mod d = x then
writeln(x, ' ', x*x)
end;
15. , , , :
Procedure square(n : integer);
label 1;
var
a, b, k : integer;
begin
a := 1; k := 1;
while a*a + 1 <= n do
begin
k := k + 1; a := a + 1
end;
for a := 1 to k do
for b := 1 to a do if a*a + b*b = n then
begin
writeln(n, '=', a, '*', a, '+', b, '*', b); goto 1
end;
1: end;
16. [n; m].
Procedure pifagor(n, m : integer);
var
a, b, c : integer;
begin
writeln(' [',n, ';', m,']');
for a := n to m do
for b := n to a do
for c := n to m do
if a*a + b*b = c*c then writeln(a, ' ', b, ' ', c)
end;
17. n .
Procedure sum_number_cube(n : integer; var p : integer);
var
i, j, k : integer;
begin
k := 0; i := 1;
while i*i*i + 1 <= n do
begin
k := k + 1; i := i + 1
end;
p := 0;
for i := k downto 1 do
for j := 1 to i do
if i*i*i + j*j*j = n
then
begin
p := p + 1;
writeln(i, '*', i, '*', i, '+', j, '*', j, '*', j, '=', n)
end;
if p = 0
then
begin
write(' ', n, ' ');
writeln(' ')
end
else
writeln(' ', p)
end;
18. n .
Procedure sum_square_number(n : integer; var p : integer);
var
k, x, y, z, p : integer;
begin
k := 0; x := 1;
while x*x + 2 <= n do
begin
k := k + 1; x := x + 1
end;
p := 0;
for x := 1 to k do
for y := 1 to x do
for z := 1 to y do
if x*x + y*y + z*z = n
then
begin
p := p + 1;
writeln(x, '*', x, '+', y, '*', y, '+', z, '*', z, '=', n)
end;
if p = 0
then
begin
write(' ',n,' ');
writeln(' ')
end
else writeln(' ', p)
end;
19. , n- 1234567891011121314...
Procedure location(n : integer; var
c : integer);
var
p, s, v, m, q : integer;
Procedure number(n : integer; var k : integer);
begin
k := 0;
repeat
k := k + 1;
n := n div 10
until n = 0
end;
begin
p := 1; s := 0;
repeat
number(p, v);
s := s + v; p := p + 1
until s>=n;
m := s - n; p := p - 1; q := 1;
for i := 1 to m do q := q*10;
c := p div q;
c := c mod 10;
writeln(' ', c);
writeln(' ', p)
end;
20. :
repeat ... until
...
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;
for ... to
... do ...
Procedure extent(a, n : integer; var s : longint);
var
i : integer;
begin
s := 1;
for i := 1 to n do s := s*a
end;
:
Function extent(a, n : longint) : longint;
var
i : integer;
begin
extent := 1;
for i := 1 to n do extent := extent*a
end;
21. :
Procedure fac(n : integer; var f : longint);
var
i : integer;
begin
if n = 0 then f := 1 else for i := 1 to n do f := f*i
end;
Procedure fac(n : integer; var f : longint);
begin
if (n = 0) or (n = 1) then f := 1
else
begin
fac(n - 1, f);
f := f*n
end
end;
22. a b, :
Procedure umnogenie(a, b, s : integer);
begin
if b <> 0
then
begin
s := s + a*(b mod 10);
umnogenie(a, b div 10, s div 10);
write(s mod 10:1)
end
else
if s <> 0 then write(s)
end;
23. .
Function fib(n : integer) : integer;
var
f, f1, f2, i : integer;
begin
f1 := 1; f := 0;
for i := 1 to n do
begin
f2 := f1; f1 := f;
f := f1 + f2;
end;
fib := f
end;
Function fib(n : integer) : integer;
begin
if (n = 1) or (n = 2)
then fib := 1
else fib := fib(n - 1) + fib(n - 2)
end;
24. [a; b] fx, .. , (h - ), (x1, x2 - ).
Procedure separation_root(a, b, h : real);
var
x1, x2, y1, y2 : real; k : integer;
Function fx(x : real) : real;
begin
fx := ???????????
end;
begin
k := 0; x1 := a; x2 := x1 + h;
y1 := fx(x1);
while x2 <= b do
begin
y2 := fx(x2);
if y1*y2 < 0
then
begin
k := k + 1;
writeln(k, '- [', x1:6:4, '; ', x2:6:4,']')
end;
x1 := x2; x2 := x1 + h;
y1 := y2
end
end;
25. func(x) (a, b - , eps - , x - , d - ).
Procedure half(a, b, eps : real; var
x, d : real);
var
c : real;
begin
while abs(b - a) > eps do
begin
c := (a + b)/2;
if func(a)*func(c) < 0 then b := c
else a := c
end;
x := (a + b)/2;
d := abs(b - a)/2
end;
26. .
{ }
Procedure minfib(a, b, e : real; var x : real);
label 1;
var
aa, bb, x1, x2, y1, y2 : real;
n : integer;
{----------------------------------------------------------------------------------------}
{ }
Function func(x : real) : real;
begin
func := ?????????????????
end;
{----------------------------------------------------------------------------------------}
{ }
Function fib(n : integer) : real;
var
f, f1, f2 : real;
i : integer;
begin
f1 := 1; f := 0;
for i := 1 to n do
begin
f2 := f1; f1 := f;
f := f1 + f2
end;
fib := f
end;
{----------------------------------------------------------------------------------------}
{ . }
{ approach - }
Procedure approach(a, b : real; n : integer; var
x2, y2 : real);
begin
x2 := a + (b - a)*fib(n - 1)/fib(n);
y2 := func(x2)
end;
begin
n := 3;
approach(a, b, n, x2, y2);
while abs(b - a) > e do
begin
x1 := a + b - x2; y1 := func(x1);
if (x2 > x1) and (y2 > y1)
then
begin
n := n + 1;
approach(a, b, n, x2, y2);
b := x2; x2 := x1; y2 := y1; goto 1
end;
if (x2 <= x1) and (y2 > y1)
then
begin
n := n + 1;
approach(a, b, n, x2, y2);
a := x2; x2 := x1; y2 := y1; goto 1
end;
if (x2 > x1) and (y2 < y1)
then
begin
n := n + 1;
approach(a, b, n, x2, y2);
a := x1; goto 1
end;
if (x2 <= x1) and (y2 <= y1)
then
begin
n := n + 1;
approach(a, b, n, x2, y2);
b := x1; goto 1
end;
n := n + 1;
approach(a, b, n, x2, y2);
1: end;
x := (a + b)/2;
end;
27. .
Procedure mingold(a, b, e : real; var
x : real);
var
x1, x2, y1, y2 : real;
{----------------------------------------------------------------------------------------}
Function func(x : real):real;
begin
func := ????????????
end;
{----------------------------------------------------------------------------------------}
Function f1(a, b : real) : real;
begin
f1 := 0.618*a + 0.382*b
end;
{----------------------------------------------------------------------------------------}
Function f2(a, b : real) : real;
begin
f2 := 0.382*a+0.618*b
end;
{----------------------------------------------------------------------------------------}
begin
x1 := f1(a, b); y1 := func(x1);
x2 := f2(a, b); y2 := func(x2);
while abs(b - a) > e do
if y1<y2 then
begin
b := x2; x2 := x1; y2 := y1;
x1 := f1(a, b); y1 := func(x1)
end
else
begin
a := x1; x1 := x2; y1 := y2;
x2 := f2(a, b); y2 := func(x2)
end;
x := (a + b)/2
end;
28. ax + by = c:
Procedure
The_equation(a, b, c : integer); { ax + by = c}
label 1;
var
max, x, y, n : integer;
begin
if (nod(a, b) <> 1) and
(c mod nod(a, b) = 0)
then begin n:= nod(a,b); a := a div n; b := b div n; c := c div n end
else if (nod(a, b) <> 1) and (c mod nod(a, b) <> 0)
then
writeln(' ');
if
abs(a) > abs(b) then max := abs(a) else max := abs(b);
for x := -max to max do
for y := -max to x do
begin
if (a*x + b*y = 1) and
(a > 0) and (b > 0)
then begin writeln(' x = ', x*c, '+', b,'*t, y = ', y*c, '-', a, '*t,');
writeln(' t - '); goto 1 end;
if
(a*x + b*y = 1) and (a < 0) and (b > 0)
then begin writeln(' x = ', x*c, '+', b,'*t, y = ', y*c, ' ', a, '*t,');
writeln(' t - '); goto 1 end;
if
(a*x + b*y = 1) and (a > 0) and (b < 0)
then begin writeln(' x = ', x*c, ' ', b,'*t, y = ', y*c, '-', a, '*t,');
writeln(' t - '); goto 1 end;
if
(a*x + b*y = 1) and (a < 0) and (b < 0)
then begin writeln(' x = ', x*c, ' ', b,'*t, y = ', y*c, ' ', a, '*t,');
writeln(' t - '); goto 1 end
end;
1: end;
u0, u1, ..., u15
174.
175.
176.
a128, r 4.
178.
179.
180. an
an
181. , un ?
182. ,
183. , n- : )
)
, xn+1 xn 堠
)
3
Program Task3;
uses WinCrt;
var
n : integer;
y, eps : real;
{----------------------------------------------------------------------------------------}
Function
t(eps : real) : integer;
var
k : integer;
begin
k := -1;
repeat
eps := eps*10;
k := k + 1
until
eps > 1;
t := k
end;
{----------------------------------------------------------------------------------------}
Procedure
Element_succession(eps : real; var n : integer; var y : real);
var
k : integer;
begin
n := 1;
y := 1;
k := -1;
while abs(y - 2) >= eps do
begin
n := n + 1;
k := k*(-1);
y := 2 + k/n
end
end;
{----------------------------------------------------------------------------------------}
{ }
begin
writeln(' ');
write(' '); readln(eps);
Element_succession(eps, n, y);
writeln(' ', y:6:t(eps));
writeln(' ', n , '- ')
end.
4
Program Task4;
uses
WinCrt;
var
i, j, n : integer;
k, k1 : longint;
yn, ym, eps : real;
{----------------------------------------------------------------------------------------}
Function
t(eps : real) : integer;
var
k : integer;
begin
k := -1;
repeat
eps := eps*10;
k := k + 1
until
eps > 1;
t := k
end;
{----------------------------------------------------------------------------------------}
begin
writeln(' ');
write(' '); readln(eps);
i := 1;
yn := 1/3;
k := 2;
while
abs(yn - 1) >= eps do
begin
i := i + 1;
k := k*2;
yn := (k - 1)/(k + 1)
end;
writeln(' |yn - 1| < ', eps:1:t(eps), ' ');
writeln(' yn = ', yn:6:t(eps), ',');
writeln(' ', i); writeln;
write(' ');
write(' ', i, ' '); readln(n);
j := i; ym := yn;
k1 := k;
while
j <= n do
begin
j := j + 1;
k1 := k1*2;
ym := (k1 - 1)/(k1 + 1);
end;
if
abs(ym - 1) < eps
then
begin
write(' abs(1 - ',ym:6:t(eps),') <', eps:1:t(eps));
writeln(' ')
end
else
begin
write(' abs(1-', ym:6:t(eps),') <', eps:1:t(eps));
writeln(' ')
end
end.
5
Program Task5;
uses
WinCrt;
var
n : longint;
u, u1, eps : real;
{----------------------------------------------------------------------------------------}
Function
s(k : integer) : longint;
var
i, z : longint;
begin
z := 1;
for
i := 1 to k do z := 3*z;
s := z
end;
{----------------------------------------------------------------------------------------}
Function
t(eps : real) : integer;
var
k : integer;
begin
k := -1;
repeat
eps := eps*10;
k := k + 1
until
eps > 1;
t := k
end;
{----------------------------------------------------------------------------------------}
{ }
begin
writeln(' eps');
write(' '); readln(eps);
u := 0;
n := 1;
repeat
u := u + 1/(s(n) + 1);
n := n + 1;
u1 := u + 1/(s(n) + 1);
until
abs(u1 - u) < eps;
writeln(' ', u1:6:t(eps));
writeln(' ', eps:1:t(eps))
end.
