Моделирование сложения двоичных чисел

{ ------------------------------------------------------------------------ }

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.