Моделирование сложения двоичных чисел
{ ------------------------------------------------------------------------ }
var sr,sf,ss:string;
function BinAdd(s1,s2:string):string;
var s:string; l,i,d,carry:byte;
begin
{выравнивание строк по длине}
if length(s1)>length(s2) then while length(s2)<length(s1) do s2:='0'+s2
else while length(s1)<length(s2) do s1:='0'+s1;
l:=length(s1);
s:=''; carry:=0;
for i:=l downto 1 do begin
d := (ord(s1[i])-ord('0')) + (ord(s2[i])-ord('0')) + carry;
carry := d div 2;
d:=d mod 2;
s:=char(d+ord('0')) + s;
end;
if carry<>0 then s:='1'+s;
BinAdd:=s;
end;
begin
writeln('введите 1-е двоичное число:');
readln(sf);
writeln('введите 2-е двоичное число:');
readln(ss);
sr:=BinAdd(sf,ss);
writeln('результат сложения = ',sr);
end.
Моделирование вычитания двоичных чисел
{ ------------------------------------------------------------------------ }
var sr,sf,ss:string;
{ вычитание двоичных строк, первое число должно быть >= второго }
function BinSub(s1,s2:string):string;
var s:string; l,i,j:byte;
begin
{выравнивание строк по длине}
if length(s1)>length(s2) then while length(s2)<length(s1) do s2:='0'+s2
else while length(s1)<length(s2) do s1:='0'+s1;
l:=length(s1); {начало алгоритма вычитания}
s:='';
for i:=l downto 1 do begin
case s1[i] of
'1': if s2[i]='0' then s:='1'+s else s:='0'+s;
'0': if s2[i]='0' then s:='0'+s else begin
s:='1'+s;
if (s1[i-1]='1') then s1[i-1]:='0' else begin
j:=1;
while (i-j>0) and (s1[i-j]='0') do begin
s1[i-j]:='1';
inc(j);
end;
s1[i-j]:='0';
end;
end;
end;
end;
{Уничтожение передних нолей}
while (length(s)>1) and (s[1]='0') do delete(s,1,1);
BinSub:=s;
end;
begin
writeln('введите 1-е двоичное число:');
readln(sf);
writeln('введите 2-е двоичное число:');
readln(ss);
sr:=BinSub(sf,ss);
writeln('результат вычитания = ',sr);
end.
Возведение целого числа в натуральную степень
Вариант 1 (обычный)
var x,y:integer;
function Degree(a,b:integer):longint;
var r:longint;
begin
r:=1;
while b>0 do begin
r:=r*a;
b:=b-1;
end;
Degree:=r;
end;
begin
writeln('введите число и (через пробел) степень числа');
readln(x,y);
writeln(Degree(x,y)); { print x^y }
end.
Вариант 2 (более быстрый и эффективный)
var x,y:integer;
function Degree(a,b:integer):longint;
var r:longint; c:integer;
begin
r:=1; c:=a;
while b>0 do begin
if odd(b) then begin
r:=r*c;
dec(b);
end else begin
c:=c*c;
b:=b div 2;
end;
end;
Degree:=r;
end;
begin
writeln('введите число и (через пробел) степень числа');
readln(x,y);
writeln(Degree(x,y)); { print x^y }
end.
Умножение длинных натуральных десятичных чисел
{ Введенное число помещается поразрядно в массив ROW. }
{ Могут умножаться числа до 10000 разрядов }
{ ------------------------------------------------------------------------ }
{$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
uses crt;
var {-------- use calc factorial ---------}
row : array[1..20000] of byte;
col : array[1..10000] of byte;
nr,nc,dp : integer;
c : char;
procedure PrintResult;
begin
write('Р е з у л ь т а т = ');
while (dp<=high(row)) do begin
write(char(row[dp]+ord('0')));
inc(dp);
end;
writeln;
end;
Умножение по Аль-Хорезми, в ROW - 1 число,в COL - 2 число
{Результат пишется в конец массива ROW }
procedure Multiplying;
var i,j,cr,cc:integer;
carry,sum:longint;
begin
dp:=high(row); cr:=nr; cc:=nc;
carry := 0;
while (cc>0) do begin
i:=cr; j:=cc; sum:=carry;
while (i<=nr) and (j>=1) do begin
sum:=sum+row[i]*col[j];
inc(i); dec(j);
end;
row[dp]:=sum mod 10; dec(dp);
carry:=sum div 10;
if cr>1 then dec(cr) else dec(cc);
end;
while (carry<>0) do begin
row[dp]:=carry mod 10;
carry:=carry div 10;
dec(dp);
end;
inc(dp);
end;
begin
{обнуление массивов-множителей}
fillchar(row,sizeof(row),0); fillchar(col,sizeof(col),0);
{поразрядный ввод 1-го числа}
writeln('введите 1-е число число:');
c:=#0;
while NOT(c in ['0'..'9']) do c:=readkey;
nr:=0;
while (c in ['0'..'9']) do begin
write(c);
inc(nr); row[nr]:=ord(c)-ord('0');
c:=readkey;
end;
writeln;
{поразрядный ввод 2-го числа}
writeln('введите 2-е число число:');
while NOT(c in ['0'..'9']) do c:=readkey;
nc:=0;
while (c in ['0'..'9']) do begin
write(c);
inc(nc); col[nc]:=ord(c)-ord('0');
c:=readkey;
end;
writeln;
{вызов процедуры умножения, затем - вызов процедуры вывода результата}
Multiplying; PrintResult;
end.
Кодировка. Пример простой кодировки (сдвиг по ключу)
{--------------------------------------------------------------------------}
{ Алгоритм: каждый код символа увеличивается на некоторое число - "ключ" }
{--------------------------------------------------------------------------}
var s:string;
i,key:integer;
begin
writeln('Введите текст'); readln(s);
writeln('Введите ключ (число от 1 до 255)'); readln(key);
for i:=1 to length(s) do s[i]:=char( ord(s[i]) + key );
writeln('Зашифрованный текст: ',s);
end.
Обработка текста
Подсчет количества слов в тексте
{--------------------------------------------------------------------------}
{ На входе - текст, на выходе - количество слов в тексте }
{--------------------------------------------------------------------------}
const Alpha : set of char=['A'..'Z','А'..'П','Р'..'Я','a'..'z','а'..'п','р'..'я'];
var s:string;
i:integer;
wc:integer;
begin
writeln('Введите текст'); readln(s);
i:=1; wc:=0;
Repeat
while NOT(s[i] in Alpha) and (i<=length(s)) do inc(i);
if (i<=length(s)) then inc(wc);
while (s[i] in Alpha) and (i<=length(s)) do inc(i);
Until (i>length(s));
writeln('Количество слов в этом тексте = ',wc);
end.
Выделение слов из текста
{--------------------------------------------------------------------------}
{ На входе - текст, на выходе - список слов }
{--------------------------------------------------------------------------}
const Alpha : set of char=['A'..'Z','А'..'П','Р'..'Я','a'..'z','а'..'п','р'..'я'];
var s,t:string;
i:integer;
begin
writeln('Введите текст'); readln(s);
writeln('Список слов в тексте:');
i:=1;
Repeat
while NOT(s[i] in Alpha) and (i<=length(s)) do inc(i);
t:='';
while (s[i] in Alpha) and (i<=length(s)) do begin
t:=t+s[i];
inc(i);
end;
if length(t)<>0 then writeln(t);
Until (i>length(s));
end.
Выделение чисел из текста
{--------------------------------------------------------------------------}
{ На входе - текст, на выходе - список чисел }
{--------------------------------------------------------------------------}
const Digits : set of char=['0'..'9'];
var s,d:string;
i:integer;
begin
writeln('Введите текст, в котором есть и цифры:'); readln(s);
writeln('Список чисел в тексте:');
i:=1;
Repeat
while NOT(s[i] in Digits) and (i<=length(s)) do inc(i);
d:='';
while (s[i] in Digits) and (i<=length(s)) do begin
d:=d+s[i];
inc(i);
end;
if length(d)<>0 then writeln(d);
Until (i>length(s));
end.