Rambler's Top100

Целочисленная арифметика

  1. Подсчитать кол-во цифр в заданном натуральном числе.
  2. Найдите целые числа-палиндромы, которые при возведении в квадрат тоже дают палиндромы.
  3. Поменять местами первую и последнюю цифры числа.
  4. Дано нат. K. напечатать К-ю цифру последовательности 12345678910111213...,в которой записаны подряд все натуральные числа.
  5. Дано число N<=99. Дописать в начало и в конец числа цифру k.
  6. Проверить, есть ли в записи числа N в степени k цифра m.
  7. Найти наименьшее нат. число, представимое двумя различными способами в виде суммы кубов двух натуральных чисел.
  8. Доказать, что любую целочисленную денежную сумму большую 7 рублей можно выплатить без сдачи трешками и пятерками.
  9. Дано нат. K. напечатать К-ю цифру последовательности 149162536..., в которой записаны подряд квадраты всех натуральных чисел.
  10. Есть ли в записи числа 3 одинаковые цифры.
  11. Дано натур число n<=9999. Поменять порядок следования цифр.
  12. Перевод числа из 10-ой системы счисления в 2-ую.
  13. Найти все делители натурального числа N.
  14. Переставить цифры числа так, чтобы образовалось максимальное число, записанное теми же цифрами.
  15. Переставить цифры числа так, чтобы образовалось наименьшее число, записанное теми же цифрами.
  16. Составить программу перевода римских чисел в арабские.
  17. Дано натур. число N. Если это не палиндром реверсируйте его цифры и сложите исходное число с числом, полученным в результате реверсирования. Если сумма не палиндром, то повторите те же действия и выполняйте их до тех пор, пока не получится палиндром. Пример: 78+87=165, 165+561=726, 726+627=1353, 1353+3531=4884
  18. Дано натур. число N. Поменять порядок следования цифр в этом числе на обратный.
  19. Дано натур. число N. Найти и вывести все числа в интервале от 1 до N-1, у которых произведение всех цифр совпадает с суммой цифр данного.
  20. Найти произведение цифр заданного целого четырехзначного числа. Число Результат: 2314 P = 24, -1245 P = 40
  21. Определить является ли заданная последовательность чисел а1, а2,...,аN монотонно убывающей. Случай Результат: N Вектор А, Является 3 (3, 2, 1) "Да", Не является 3 (2, 3, 1) "Нет"

Целочисленная арифметика РешенияВверх

1.

program N1{подсчитать кол-во цифр в заданном натуральном числе};

var N:integer;

function KOL(N:integer):integer;

begin

if N>9 then KOL:=KOL(N mod 10)+KOL(N div 10)

else KOL:=1;

end;

BEGIN

Write('Введите N');ReadLn(N);

WriteLn(KOL(N));

ReadLn;

END.

 Вверх

2.

program borlpasc;

{найдите целые числа-палиндромы, которые при возведении в квадрат

тоже дают палиндромы}

var i,i1,i2:longint;

function Palindrom(n:longint):boolean;

var n1,n2,o:longint;

begin n1:=n;n2:=0; {n1 - данное число, n2 - число которое получится}

while n1>0 do

begin o:=n1 mod 10;{о - остаток от деления на 10}

n1:=n1 div 10;

n2:=n2*10+o;

end;

Palindrom:=(n=n2);

end;

begin writeln('Введите интервал поиска:');

write('Начало интервала:');readln(i1);

write('Конец интервала:');readln(i2);

for i:=i1 to i2 do

if Palindrom(i) and Palindrom(sqr(i))

then writeln(i,'-палиндром ',sqr(i),'-палиндром');

end.

 Вверх

3.

{Поменять местами первую и последнюю цифры числа}

program borlpasc;

var b,a,n,k:integer;

begin write('введите число n=');

readln(n);

k:=n;

a:=k mod 10;

repeat b:=k mod 10;

k:=k div 10

until k div 10 =0;

b:=k mod 10;

 

writeln(a,n div 10 div 10 mod 10,n div 10 mod 10,b)

end.

 Вверх

4.

{дано нат. K. напечатать К-ю цифру последовательности 12345678910111213...,

в которой записаны подряд все натуральныe числa}

program borlpasc;

var i,j,k,n,o:integer;

a,t:longint;

begin write('Введите k=');readln(k);

t:=0;i:=0;

repeat t:=t+1;

j:=t;

while j>0 do{считаем количество цифр в числе

и добавляем к общему количеству}

begin j:=j div 10;

i:=i+1;

{if i=k then o:=j mod 10;}

end;

until i>=k;

while i>=k do{возвращаемся по цифрам последнего числа

до нужной}

begin o:=t mod 10;

t:=t div 10;

i:=i-1;

end;

writeln('k-я цифра:',o)

end.

 Вверх

5.

{Дано число N<=99. Дописать в начало и в конец числа цифру k}

program borlpasc;

var n,k:integer;

begin write('введите k=');

readln(k);

write('введите n=');

readln(n);

writeln('Получилось число:');

write(k,n,k)

end.

 Вверх

6.

{Проверить, есть ли в записи числа N в степени k цифра m}

Program borlpasc;

var i,n,m,s,k,l,a:integer;

begin write('введите n=');

readln(n);

write('введите k=');

readln(k);

write('введите цифру m=');

readln(m);

i:=0;l:=0;s:=1;

repeat s:=s*n;

i:=i+1

until i=k;

repeat a:=s mod 10;

if a=m then l:=l+1;

s:=s div 10

until s=0;

if l=0 then writeln('В записи числа нет цифры',' ',m)

else writeln('В записи числа цифра ',m,' есть')

end.

 Вверх

7.

{Найти наименьшее нат. число, представимое двумя различными способами

в виде суммы кубов двух натуральных чисел}

program borlpasc;

var i,k:integer;

x,y:integer;

begin i:=1; k:=0;

repeat i:=i+1;

for y:=1 to i-1 do

for x:=1 to i do

if x*x*x+y*y*y=i then k:=k+1

until k>=2; writeln(x,y);

writeln('наим нат число=',i)

end.

 Вверх

8.

{Доказать, что любую целочисленную денежную сумму

большуую 7 рублей можно выплатить без сдачи

трешками и пятерками. *целочисленная арифметика* }

program borlpasc;

var n,n3,n5,k:integer;

begin write('Введите сумму(>7) n=');

readln(n);

k:=0;

for n3:=0 to (n div 3) do

for n5:=0 to (n div 5) do

begin if n3*3+n5*5=n

then writeln(n3,' трешки и ',n5,' пятерок');

k:=k+1

end;

if k=0

then writeln('Из трешек и пятерок эту сумму не сложить.')

end.

Вверх 

9.

{дано нат. K. напечатать К-ю цифру последовательности 149162536...,

в которой записаны подряд квадраты всех натуральных чисел}

program borlpasc;

var i,j,k,n,o:integer;

a,t:longint;

begin write('Введите k=');readln(k);

j:=0;a:=1;i:=0;

repeat j:=j+1;a:=sqr(j);

t:=a;

while t>0 do{считаем количество цифр в числе

и добавляем к общему количеству}

begin t:=t div 10;

i:=i+1;

end;

until i>=k;

t:=a;

while i>=k do{возвращаемся по цифрам последнего числа

до нужной}

begin o:=t mod 10;

t:=t div 10;

i:=i-1;

end;

writeln('k-я цифра:',o)

end.

 Вверх

10.

PROGRAM borlpasc;{Есть ли в записи числа 3 одинак цифры}

VAR N:INTEGER;a,b,c,d:integer;

BEGIN WRITE('ВВЕДИТЕ ЧИСЛО N=');

READLN(N);

a:=n div 1000;

b:=n div 100 mod 10;

c:=n div 10 mod 10;

d:=n mod 10;

IF (a=b) and (a=c) or (a=b) and (a=d) or (a=c) and (a=d) or

(b=c) and (b=d)

THEN WRITELN('В ЗАПИСИ ЧИСЛА ЕСТЬ 3 ОДИНАКОВЫЕ ЦИФРЫ')

ELSE WRITELN('В ЗАПИСИ ЧИСЛА НЕТ ТРЕХ ОДИНАКОВЫХ ЦИФР')

END.

 Вверх

11.

{Дано натур число n<=9999. Поменять порядок следования цифр.}

program borlpasc;

var s,x:integer;

begin write('введите число=');

readln(x);

s:=0;

repeat s:=s*10+x mod 10;

x:=x div 10

until x=0;

writeln(s)

end.

 Вверх

12.

PROGRAM borlpasc; {ПЕРЕВОД ЧИСЛА ИЗ 10-ОЙ СИСТЕМЫ СЧИСЛЕНИЯ В 2-УЮ}

TYPE massiv=array [1..50] of integer;

var a:massiv;

n,i:integer;

begin write('введите число:');

readln(n);

i:=1;

while n>=2 do

begin a[i]:= n mod 2;

i:=i+1;

n:= n div 2;

end;

i:=i-1;

write(n);

while i<>0 do

begin write(' ',a[i]);

i:=i-1;

end;

writeln

end.

 Вверх

13.

{Найти все делители натурального числа N}

program borlpasc;

const kol=100;

type cyfra=0..9;

chislo=array[1..kol] of cyfra;

var i,r,d,s,k,code:integer;

j,c0,c1,x,y,z,o,z1,n,lastd:chislo;

p:boolean;

function sravnenie(x,y:chislo):integer;

var i,r:integer;

begin r:=0;i:=1;

repeat if (x[i])>(y[i]) then r:=1;

if x[i]<y[i] then r:=-1;

i:=i+1;

until (r<>0)or(i>kol);

sravnenie:=r;

end;

procedure add(x,y:chislo;var z:chislo);

var p,a,b,c:integer;

begin p:=0;

for i:=kol downto 1 do

begin a:=x[i];

b:=y[i];

c:=a+b+p;

z[i]:=c mod 10;

p:=c div 10;

end;

if p>0 then begin write('переполнение');

readln

end

end;

procedure sub (x,y:chislo;var z:chislo);

var i,j,p,l,a,b,r,c:integer;

begin p:=0;

for i:=kol downto 1 do

begin a:=(x[i]);

b:=(y[i]);

c:=a-b+p;

if c<0 then begin c:=c+10;

p:=-1;

end

else p:=0;

z[i]:=(c);

end;

if p<0 then begin write('отриц.число');

readln

end;

end;

procedure Division(x,y:chislo;var z,O:chislo);

var a,b,r,c,i,j,xt,yt,yt1,s:integer;

y1:chislo;

begin z:=C0; o:=x;

if sravnenie(x,y)=-1 then exit;

y1:=y;

yt:=1;while y[yt]=0 do inc(yt);

xt:=1;while x[xt]=0 do inc(xt);

s:=yt-xt;yt1:=xt;

for i:=1 to kol do if i+s<=kol then y1[i]:=y1[i+s]

else y1[i]:=0;

while yt1<=yt do

begin r:=0;

while not(sravnenie(x,y1)=-1) do

begin Sub(x,y1,x);

r:=r+1

end;

for i:=1 to kol-1 do z[i]:=z[i+1];

z[kol]:=r;r:=0;

for i:=kol downto 2 do y1[i]:=y1[i-1];

y1[1]:=0;yt1:=yt1+1;

end;

o:=x

end;

procedure print(x:chislo);

var i:integer;

p:boolean;

begin p:=false;

for i:=1 to kol do

begin if x[i]<>0 then p:=true;

if p then write(x[i])

end;

if not(p) then write(0)

end;

procedure input(var x:chislo);

var i,j:integer; s:string;

begin readln(s);

x:=c0;j:=kol;

for i:=length(s) downto 1 do

begin val(s[i],x[j],code);

j:=j-1;

end;

end;

begin for i:=1 to kol do c0[i]:=0;

c1:=c0;c1[kol]:=1;

write('Введите n=');input(n);x:=n;

j:=c1;add(j,c1,j);k:=0;

writeln('Делители:');

writeln(1);p:=true;lastd:=c1;

while not(sravnenie(x,j)=-1) do

begin division(x,j,z,o);

if sravnenie(o,c0)=0

then begin x:=z;

if not(sravnenie(lastd,j)=0)

then begin k:=k+1;

lastd:=j;

print(j);

writeln

end

end

else add(j,c1,j);

end;

writeln('Всего ',k+1,' делителей');

readln

end.

 Вверх

14.

{Переставить цифры числа так, чтобы образовалось максимальное число,

записанное теми же цифрами}

program borlpasc;

var n:string; c:char;i,j:integer;

begin write('введите n'); readln(n);

for j:=1 to length(n) do

for i:=1 to length(n)-1 do

if n[i]<n[i+1] then begin c:=n[i]; n[i]:=n[i+1]; n[i+1]:=c;

end;

writeln('n=',n);

end.

 Вверх

15.

{Переставить цифры числа так, чтобы образовалось наименьшее число,

записанное теми же цифрами}

program borlpasc;

var n:string; c:char;i,j:integer;

begin write('введите n='); readln(n);

for j:=1 to length(n) do

for i:=1 to length(n)-1 do

if n[i]>n[i+1] then begin c:=n[i]; n[i]:=n[i+1]; n[i+1]:=c;

end;

writeln('n=',n);

end.

 

 Вверх

16.

program borlpasc;{составить программу перевода римских чисел в арабские}

var s:string;

n,c,c1,i,a:integer;

begin writeln('введите число:');

readln(s);

c:=0;n:=0;

for i:=1 to length(s) do

begin

c1:=c;

if s[i]='I' then c:=1;

if s[i]='V' then c:=5;

if s[i]='X' then c:=10;

if s[i]='L' then c:=50;

if s[i]='C' then c:=100;

if s[i]='D' then c:=500;

if s[i]='M' then c:=1000;

if c>c1 then a:=-2*c1

else a:=0;

n:=n+a+c

end;

writeln('ваше число=',n)

end.

 Вверх

17.

uses CRT;

var N, N2, nn:Longint;

BEGIN

ClrScr;

Write('N:= '); ReadLn(N);

nn:= 0;

repeat

N:= N+ nn;

nn:= 0;

N2:= N;

while N>0 do begin

nn:= nn*10+(N mod 10);

N:= N div 10;

end;

N:= N2;

Write(#13#10,N,'+ ', nn, '=');

until N=nn;

WriteLn(' Ответ');

Write('< Ok >'); ReadKey;

END.

 Вверх

18.

{ Дано натур. число N. Поменять порядок }

{ следования цифр в этом числе на обратный }

uses CRT;

var N, nn:Longint;

BEGIN

ClrScr;

Write('N:= '); ReadLn(N);

nn:= 0;

while N>0 do begin

nn:= nn*10+(N mod 10);

N:= N div 10;

end;

WriteLn('N''= ',nn);

Write(#10#13'< Ok >'); ReadKey;

END.

 Вверх

19.

{ Дано натур. число N. Найти и вывести все числа }

{ в интервале от 1 до N-1, у которых произведение }

{ всех цифр совпадает с суммой цифр данного }

uses CRT;

var N, nn, i, A, B:integer;

BEGIN

ClrScr;

Write('N:= '); ReadLn(N);

A:= 1;

nn:= N;

Write('Произведение ');

while nn>0 do begin

A:= (nn mod 10)* A;

if (nn mod 10)>1 then

Write(nn mod 10,'x');

nn:= nn div 10;

end;

WriteLn(#8'=',A);

WriteLn('Числа:');

for i:=1 to N-1 do begin

nn:= i;

B:=1;

while nn>0 do begin

B:= (nn mod 10)* B;

nn:= nn div 10;

end;

if A=B then Write(i:8);

end;

Write(#10#13'< Ok >'); ReadKey;

END.

 Вверх

20

Program DigitsProduct;

Uses Crt;

Var Number, {заданное число}

i, j, k, l, {цифры числа}

P : Integer; {произведение цифр}

BEGIN ClrScr;

Write( 'Введите четырехзначное число : ' ); ReadLn(Number);

Write( 'Цифры числа ' , Number , ' : ' );

Number:=Abs(Number);

i:= Number div 1000; Write(i:3); {первая цифра}

j:= Number div 100 mod 10; Write(j:3); {вторая цифра}

k:= Number div 10 mod 10; Write(k:3); {третья цифра}

l := Number mod 10; WriteLn(l:3); {четвертая цифра}

P:= i * j * k * l ;

WriteLn( 'О т в е т : произведение цифр равно ' , P );

ReadLn

END.

 Вверх

21.

Program Decrease;

Uses Crt;

Var A : Array [1..10] of Real;

N, i : Integer;

Otvet: Boolean;

Procedure InputOutput; {описание процедуры ввода-вывода данных}

Begin

ClrScr;

Write('Количество элементов - '); ReadLn(N);

For i := 1 to N do

begin

Write('A[' , i , '] = '); ReadLn(A[i])

end; WriteLn;

 

WriteLn('Заданная последовательность чисел');

For i := 1 to N do Write(A[i] : 5 : 1);

WriteLn

End; { of InputOutput }

Procedure Processing( Var Otvet: Boolean);

Begin {описание процедуры проверки на убывание элементов}

Otvet := TRUE; i:=1;

While (i<=N-1) and Otvet do

If (A[i]<A[i+1]) then Otvet := FALSE

else i := i+1;

End; { of Processing }

Procedure Result(Otvet: Boolean); {описание процедуры вывода результата}

Begin

If Otvet then Write('образует ')

else Write('не образует ');

WriteLn('монотонно убывающую последовательность.');

ReadLn

End;

BEGIN

InputOutput; {вызов процедуры ввода-вывода}

Processing(Otvet); {вызов процедуры проверки на убывание}

Result(Otvet); {вызов процедуры вывода результата}

END.

Вверх

Белорусский рейтинг MyMinsk.com Сайты беларуси Регистр "ЗУБР" Каталог на TIGA.BY, а также  новости, работа, объявления, фото и многое другое Рейтинг@Mail.ru Rambler's Top100 Белорусский каталог программ Faststart - рейтинг сайтов, каталог интернет ресурсов, счетчик посещаемос­ти Яндекс.Метрика
Hosted by uCoz