Целочисленная арифметика
Целочисленная арифметика Решения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. 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. {Поменять местами первую и последнюю цифры числа} 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. {дано нат. 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. {Дано число N<=99. Дописать в начало и в конец числа цифру k} program borlpasc; var n,k:integer; begin write('введите k='); readln(k); write('введите n='); readln(n); writeln('Получилось число:'); write(k,n,k) end. {Проверить, есть ли в записи числа 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. {Найти наименьшее нат. число, представимое двумя различными способами в виде суммы кубов двух натуральных чисел} 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. {Доказать, что любую целочисленную денежную сумму большуую 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. {дано нат. 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. 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. {Дано натур число 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. 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. {Найти все делители натурального числа 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. {Переставить цифры числа так, чтобы образовалось максимальное число, записанное теми же цифрами} 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. {Переставить цифры числа так, чтобы образовалось наименьшее число, записанное теми же цифрами} 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.
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. 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. { Дано натур. число 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. { Дано натур. число 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. 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. 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. |