Вычисление площади треугольника по 3 вершинам
var x1,y1,x2,y2,x3,y3,a,b,c,p,s:real;
begin
writeln('введите A(X1,Y1), B(X2,Y2) и C(X3,Y3)');
readln( x1,y1,x2,y2,x3,y3 );
c:=sqrt(sqr(y1-y2)+sqr(x1-x2));
a:=sqrt(sqr(y2-y3)+sqr(x2-x3));
b:=sqrt(sqr(y1-y3)+sqr(x1-x3));
p:=(a+b+c)/2;
s:=p*sqrt((p-a)*(p-b)*(p-c));
writeln('площадь треугольника = ',s);
end.
19. Попадает ли точка M(x,y) в круг с центром O(Xc,Yc) и радиусом R
var xc,yc,mx,my,d,r:real;
begin
writeln('введите M(X,Y), O(Xc,Yc) и R');
readln( mx,my,xc,yc,r );
d:=sqrt(sqr(xc-mx)+sqr(yc-my));
if d<=r then writeln ('точка M лежит в круге')
else writeln ('точка M лежит вне круга');
end.
Перевод десятичного числа в двоичное
var a : longint;
function DEC_BIN(x:longint):string;
const digits:array [0..1] of char = ('0','1');
var res:string; d:0..1;
begin
res:='';
while (x<>0) do begin
d:=x mod 2; res:=digits[d]+res;
x:=x div 2;
end;
DEC_BIN:=res;
end;
begin { основная программа }
readln( a );
writeln( DEC_BIN(a) );
end.
Перевод двоичного числа в десятичное
var a : string;
function BIN_DEC(x:string):longint;
const digits:array [0..1] of char = ('0','1');
var res,ves:longint; i,j:byte;
begin
res:=0; ves:=1;
for i:=length(x) downto 1 do begin
j:=0;
while (digits[j]<>x[i]) do inc(j);
res:=res+ves*j;
ves:=ves*2;
end;
BIN_DEC:=res;
end;
begin { основная программа }
readln( a );
writeln( BIN_DEC(a) );
end.
Перевод десятичного числа в шестнадцатеричное
var a : longint;
function DEC_HEX(x:longint):string;
const digits:array [0..15] of char = ('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
var res:string; d:0..15;
begin
res:='';
while (x<>0) do begin
d:=x mod 16;
x:=x div 16;
res:=digits[d]+res;
end;
DEC_HEX:=res;
end;
begin { основная программа }
readln( a );
writeln( DEC_HEX(a) );
end.
Перевод шестнадцатеричного числа в десятичное
var a : string;
function HEX_DEC(x:string):longint;
const digits:array [0..15] of char =
('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var res,ves:longint; i,j:byte;
begin
res:=0; ves:=1;
for i:=length(x) downto 1 do begin
j:=0; a[i]:=UpCase(a[i]);
while (digits[j]<>x[i]) do inc(j);
res:=res+ves*j;
ves:=ves*16;
end;
HEX_DEC:=res;
end;
begin { основная программа }
readln( a );
writeln( HEX_DEC(a) );
end.
Рекурсивные алгоритмы
Нахождение НОД и НОК двух чисел
var a,b:longint;
function NOD(x,y:longint):longint; { фукнция поиска наиб. общ. делителя }
begin
if x<>0 then NOD:=NOD(y mod x,x) else NOD:=y;
end;
function NOK(x,y:longint):longint; { фукнция поиска наим. общ. кратного }
begin
NOK:=( x div NOD(x,y) ) * y;
end;
begin { основная программа }
readln(a,b);
writeln( 'НОД этих чисел = ', NOD(a,b) );
writeln( 'НОК этих чисел = ', NOK(a,b) );
end.
Вычисление факториала
var n:integer;
function f(x:integer):longint;
begin
if x = 1 then f := 1 else f := x * f(x-1);
end;
begin
writeln('введите N (N=1..13)');
readln(n);
writeln('N!=',f(n));
end.
Генерация перестановок
const n = 3; { количество элементов в перестановке}
var a:array[1..n] of integer;
index : integer;
procedure generate (l,r:integer);
var i,v:integer;
begin
if (l=r) then begin
for i:=1 to n do write(a[i],' ');
writeln;
end else begin
for i := l to r do begin
v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[j]}
generate(l+1,r); {вызов новой генерации}
v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[j]}
end;
end;
end;
begin
for index := 1 to N do A[index]:=index;
generate( 1,n );
end.
Быстрая сортировка
{ ----------------------------------------------------------------------- }
{ БЫСТРАЯ СОРТИРОВКА. }
{ Устанавливаем I=1 и J=N. Сравниваем элементы A[I] и A[J]. Если }
{ A[I]<=A[J], то уменьшаем J на 1 и проводим следующее сравнение элемен- }
{ тов A[I] с A[J]. Последовательное уменьшение индекса J и сравнение ука- }
{ занных элементов A[I] с A[J] продолжаем до тех пор, пока выполняется }
{ условие A[I] <= A[J]. Как только A[I] станет больше A[J], меняем места- }
{ ми элементы A[I] с A[J], увеличиваем индекс I на 1 и продолжаем сравне- }
{ ние элементов A[I] с A[J]. Последовательное увеличение индекса I и }
{ сравнение (элементов A[I] с A[J]) продолжаем до тех пор, пока выполня- }
{ ется условие A[I] <= A[J]. Как только A[I] станет больше A[J], опять }
{ меняем местами элементы A[I] с A[J], снова начинаем уменьшать J. }
{ Чередуя уменьшение J и увеличение I, сравнение и необходимые обме- }
{ ны, приходим к некоторому элементу, называемому пороговым или главным, }
{ характеризующим условие I=J. В результате элементы массива оказываются }
{ разделенными на две части так, что все элементы слева - меньше главного }
{ элемента, а все элементы справа - больше главного элемента. }
{ К этим массивам применяем рассмотренный алгоритм, получаем четыре }
{ части и т.д. Процесс закончим, когда массив A станет полностью отсорти- }
{ рованным. }
{ При программировании алгоритма "Быстрой сортировки" удобно исполь- }
{ зовать рекурентные вызовы процедуры сортировки (рекурсию). }
{ ----------------------------------------------------------------------- }
var a:array[1..10] of integer; { массив элементов }
n:integer;
procedure QuickSort( L, R : Integer ); { Быстрая сортировка массива A[] }
var i,j,x,y : integer;
begin
i := l; j := r;
x := a[(l+r) div 2];
repeat
while (A[i]<x) do inc(i);
while (x<A[j]) do dec(j);
if ( i<=j ) then
begin
y:=A[i]; a[i]:=a[j]; a[j]:=y;
inc(i); dec(j);
end;
until (i>j);
if (l<j) then QuickSort(l,j);
if (i<r) then QuickSort(i,r);
end;
begin
writeln('введите 10 элементов массива:');
for n:=1 to 10 do readln(a[n]);
QuickSort( 1, 10 ); { на входе: левая и правая граница сортировки }
writeln('после сортировки:');
for n:=1 to 10 do writeln(a[n]);
end.