[_Nox_]

Nod

function NOD (a1,b1:int64):int64; {В мидлет паскале надо ставить integer вместо int64}
begin
  while (A1<>0) and (B1 <> 0) do
    begin
      if a1 > b1 then a1:=a1 mod b1
                 else b1:=b1 mod a1;
    end;
  NOD:=a1+b1;
end;

НOK

function NOK (a2, b2 : int64):int64;
begin
NOK:=(a2 div NOD (a2,b2){<=Добавить ещё в программу NOD из пункта сверху})*b2;
end;

3. Разложение натурального числа N<=2 000 000 000 на простые множители.

program task;
var n:int64;
    mas : array [1..100] of longint;
    i,j:longint;
    a:longint;
begin
assign (input, 'input.txt'); reset (input);
assign (output, 'output.txt'); rewrite (output);
  readln (n);
  write (N, ' = ');

  i:=0;
  while n mod 2 = 0 do
    begin
      mas [i+1]:= 2;
      inc (i);
      n:=n div 2;
    end;
  a:=3;

  while (n<>1) do
    begin
      while n mod a = 0 do
        begin
          mas [i+1]:= a;
          inc (i);
          n:=n div a;
        end;
      inc (a,2);

    end;

  if i=0 then write (n)
         else for j:=1 to i do
 		begin
  		  write (mas [j]);
                  if j<>i then write (' * ');
 		end;
  writeln;

  writeln (i);

  close (input);
  close (output);

end.

dec to bin

program dectobin;
type binmas = array [1..10000] of byte; 
var Dec : int64;
    bin : binmas;
    i:longint;

procedure indata;
const infile = 'input.txt';
begin
assign (input, infile); reset (input);
readln (Dec);
close (input);
end;

procedure dec_to_bin;
begin
i:=1;
while Dec > 0 do
 begin
  bin [i]:=Dec mod 2;
  Dec:=Dec div 2;
  inc (i);
 end;
end;

procedure outdata;
const outfile = 'output.txt';
var j:longint;
begin
assign (output, outfile); rewrite (output);
for j:=i-1 downto 1 do write (bin [j]);
close (output);
end;


begin
indata;
dec_to_bin;
outdata;
end.

bin to dec

program bintodec;
type binmas = array [1..10000] of integer;
var bin : binmas;
    N : int64;
    i,j:longint;

procedure indata;
const infile = 'input.txt';
var s:string;

begin
assign (input, infile); reset (input);

i:=1;
read (s);
for j:=1 to length (s) do
  begin
   if ord (s [j]) = ord ('1') then bin [i]:=1
                              else bin [i]:=0;
   inc (i);
  end;

close (input);
end;

procedure bin_to_dec;
var t:int64;
begin
N:=0;
t:=1;
for j:=i-1 downto 1 do
  begin
    N:=N+bin [j]*t;
    if i <> j then t:=t*2;
  end;

end;

procedure outdata;
const outfile = 'output.txt';
begin
assign (output, outfile); rewrite (output);
writeln (N);
close (output);
end;


begin
indata;
bin_to_dec;
outdata;
end.

bin to hex

program bin_to_hex;
var s,s2,t:string;
    i:integer;
begin
assign (input, 'input.txt'); reset (input);
assign (output, 'output.txt'); rewrite (output);

readln (S);
for i:=length (s) downto 1 do
  begin
   t:=s[i] + t;
   if i=1 then
     begin
      if length (t)=1 then t:='000'+t;
      if length (t)=2 then t:='00'+t;
      if length (t)=3 then t:='0'+t;
     end;
   if length (t)= 4 then
     begin
       if t = '0000' then s2:= '0' + s2 else
       if t = '0001' then s2:= '1' + s2 else
       if t = '0010' then s2:= '2' + s2 else
       if t = '0011' then s2:= '3' + s2 else
       if t = '0100' then s2:= '4' + s2 else
       if t = '0101' then s2:= '5' + s2 else
       if t = '0110' then s2:= '6' + s2 else
       if t = '0111' then s2:= '7' + s2 else
       if t = '1000' then s2:= '8' + s2 else
       if t = '1001' then s2:= '9' + s2 else
       if t = '1010' then s2:= 'A' + s2 else
       if t = '1011' then s2:= 'B' + s2 else
       if t = '1100' then s2:= 'C' + s2 else
       if t = '1101' then s2:= 'D' + s2 else
       if t = '1110' then s2:= 'E' + s2 else
       if t = '1111' then s2:= 'F' + s2;
       t:='';
     end;
  end;

writeln (s2);

close (input);
close (output);
end.

hex to bin

program hex_to_bin;
var hex_str, bin_str:string;
    i:integer;
begin
assign (input, 'input.txt'); reset (input);
assign (output, 'output.txt'); rewrite (output);

readln (hex_str);

for i:=1 to length (hex_str) do
  begin
    case hex_str [i] of
      '0' : bin_str := bin_str + '0000';
      '1' : bin_str := bin_str + '0001';
      '2' : bin_str := bin_str + '0010';
      '3' : bin_str := bin_str + '0011';
      '4' : bin_str := bin_str + '0100';
      '5' : bin_str := bin_str + '0101';
      '6' : bin_str := bin_str + '0110';
      '7' : bin_str := bin_str + '0111';
      '8' : bin_str := bin_str + '1000';
      '9' : bin_str := bin_str + '1001';
      'A' : bin_str := bin_str + '1010';
      'B' : bin_str := bin_str + '1011';
      'C' : bin_str := bin_str + '1100';
      'D' : bin_str := bin_str + '1101';
      'E' : bin_str := bin_str + '1110';
      'F' : bin_str := bin_str + '1111';
     END;

  end;

close (input);
close (output);
end.

dec to hex

program dec_to_hex;
type binmas = array [1..10000] of byte;
var Decc : int64;
    bin : binmas;
    bins: string;
    Hex : string;
    i,j:longint;
    ss:string;

procedure indata;
const infile = 'input.txt';
begin
assign (input, infile); reset (input);
readln (Decc);
close (input);
end;

procedure dec_to_bin;
begin
i:=1;
while Decc > 0 do
 begin
  bin [i]:=Decc mod 2;
  Decc:=Decc div 2;
  inc (i);
 end;
end;


procedure bin_to_hex;
var t : string;
    a : integer;
begin
assign (output, 'output.txt'); rewrite (output);
t:='';
for a:=length (bins) downto 1 do
  begin
   t := bins [a] + t;
   if a = 1 then
     begin
      if length (t)=1 then t:='000'+t;
      if length (t)=2 then t:='00'+t;
      if length (t)=3 then t:='0'+t;
     end;
   if length (t)= 4 then
     begin
       if t = '0000' then Hex:= '0' + Hex else
       if t = '0001' then Hex:= '1' + Hex else
       if t = '0010' then Hex:= '2' + Hex else
       if t = '0011' then Hex:= '3' + Hex else
       if t = '0100' then Hex:= '4' + Hex else
       if t = '0101' then Hex:= '5' + Hex else
       if t = '0110' then Hex:= '6' + Hex else
       if t = '0111' then Hex:= '7' + Hex else
       if t = '1000' then Hex:= '8' + Hex else
       if t = '1001' then Hex:= '9' + Hex else
       if t = '1010' then Hex:= 'A' + Hex else
       if t = '1011' then Hex:= 'B' + Hex else
       if t = '1100' then Hex:= 'C' + Hex else
       if t = '1101' then Hex:= 'D' + Hex else
       if t = '1110' then Hex:= 'E' + Hex else
       if t = '1111' then Hex:= 'F' + Hex;
       t:='';
     end;
  end;

writeln (hex);

close (output);
end;




begin
indata;
dec_to_bin;
bins:='';
for j:=i-1 downto 1 do
  begin
    str (bin[j],ss);
    bins:=bins+ss;
  end;
bin_to_hex;
end.

hex to dec

program hex_to_dec;
type binmas = array [1..10000] of integer;
var hex_str:string;
    bin_str:string;
	bin:binmas;
    i,j:longint;
    t,n:int64;
begin
assign (input, 'input.txt'); reset (input);
assign (output, 'output.txt'); rewrite (output);
readln (hex_str);

bin_str:='';
for i:=1 to length (hex_str) do
  begin
    case hex_str [i] of
      '0' : bin_str := bin_str + '0000';
      '1' : bin_str := bin_str + '0001';
      '2' : bin_str := bin_str + '0010';
      '3' : bin_str := bin_str + '0011';
      '4' : bin_str := bin_str + '0100';
      '5' : bin_str := bin_str + '0101';
      '6' : bin_str := bin_str + '0110';
      '7' : bin_str := bin_str + '0111';
      '8' : bin_str := bin_str + '1000';
      '9' : bin_str := bin_str + '1001';
      'A' : bin_str := bin_str + '1010';
      'B' : bin_str := bin_str + '1011';
      'C' : bin_str := bin_str + '1100';
      'D' : bin_str := bin_str + '1101';
      'E' : bin_str := bin_str + '1110';
      'F' : bin_str := bin_str + '1111';
     END;
  end;

for j:=1 to length (bin_str) do
  begin
   if ord (bin_str [j]) = ord ('1') then bin [i]:=1
                                    else bin [i]:=0;
   inc (i);
  end;

t:=1;
N:=0;
for j:=i-1 downto 1 do
  begin
    N:=N+bin [j]*t;
    if i <> j then t:=t*2;
  end;
writeln (N);
close (input);
close (output);
end.

Сортировки

1. Пузырьком

program bubble;
var mas: array [1..1000] of longint;
    n:longint;

procedure indata;
const infile = 'input.txt';
var i:longint;
begin
  assign (input, infile); reset (input);

  readln (N);
  for i:=1 to n do read (mas [i]);

  close (input);
end;

procedure outdata;
const outfile = 'output.txt';
var i:longint;
begin
  assign (output, outfile); rewrite (output);

  for i:=1 to n do write (mas [i], ' ');

  close (output);
end;

procedure sort;
var i,j:longint;
    cc:longint;
    p:boolean;
begin
p:=true;
for i:=1 to n-1 do
  begin
    {if p=false then break;
    p:=false;}
    for j:=1 to n-i do
      begin

        if mas [j]<mas [j+1] then
          begin
            p:=true;
            cc:=mas [j];
            mas [j]:=mas [j+1];
            mas [j+1]:=cc;
          end;
      end;
  end;
end;

begin
indata;

sort;

outdata;
end.

2. Быстрая сортировка (qsort)

program qsort;
var mas: array [1..1000] of longint;
    n:longint;

procedure indata;
const infile = 'input.txt';
var i:longint;
begin
  assign (input, infile); reset (input);
    
  readln (N);
  for i:=1 to n do read (mas [i]);  

  close (input);
end;

procedure outdata;
const outfile = 'output.txt';
var i:longint;
begin
  assign (output, outfile); rewrite (output);
    
  for i:=1 to n do write (mas [i], ' ');  

  close (output);
end;

procedure qsort (l,r:longint);
var i,j,m,cc:longint;
begin
i:=l;
j:=r;
m:=mas [(i+j) div 2];
while i<j do
  begin
    while mas [i]<m do inc (i);
    while mas [j]>m do dec (j);
      if i<=j then 
        begin
          cc:=mas [i];
          mas [i]:=mas [j];
          mas [j]:=cc;
          inc (i);
          dec (j);
        end;
  end;
if i<r then qsort (i,r);
if l<j then qsort (l,j);
end;

begin
indata;
qsort (1,N);
outdata;
end.

быстрое возведение в степень

program task;
var a, b:int64;

function power (a,b:int64): int64;
var tmp:int64;
begin
if b = 1 then power := a else
  begin
    tmp:= power (a, b div 2);
    if b mod 2 = 0 then power:= tmp*tmp
                   else	power:= tmp*tmp*a;
  end;
end;


begin
assign (input, 'input.txt'); reset (input);
readln (a,b);
close (input);

assign (output, 'output.txt');  rewrite (output);
writeln (power (a,b));
close (output);
end.