Вычисление площади треугольника по 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.