Javascript must be enabled in your browser to use this page.
Please enable Javascript under your Tools menu in your browser.
Once javascript is enabled Click here to go back to �нтеллектуальная Кобринщина

Функции

Программа вычисления факториала.

Program factorial;

Uses Crt;                                            

var n: integer;

Function fact(n: integer): word;

  Begin

      If n=0 then fact:=1 else fact:=n*fuct(n-1);

  End; {fact}

Begin

CIrScr;

writeln(‘Введите число, факториал которого вы хотите получить’);

readln(n);

if n<0 then writeln(‘Для отрицательного числа факториал не определён’) else writeln(‘Факториал ’, n, ‘равен: ’, fact(n));

         readln;

End.

 

Решение биквадратного уравнения ax4+bx2+c=0.

Program largest_2;

Uses Crt;                                             

var

a, b. с, d : Real;

function max2(x. у : Real.) : Real;

begin

if x > у then max2 := x else max2 := y;

    end;

Begin

     CIrScr;

     write('Введите четыре числа:');

     readln(a, b. с, d);

     writeln('Большее из ‘, a:10:5, b;10;5, c;10;5, d:10;5, ‘ = ‘,max2(max2(a, b), max2(c,d));10;5;

     readln;

End.

 

Программа вычисления площади n-угольника.

Рrogram area;

Uses Crt;

const n= 4;                         

var                               

х, у : array[1..n] of Real;

i : Word;

su, pi : Real;

function length(nl, n2 : Word) : Real;

begin

    length := Sqrt(sqr(x[nl] - x[n2]) + sqr(y[nl] - y[n2]))

     end; {length}

procedure space(nl, n2, n3 : Word; var pi : Real);

var

a, b, c, p: Real;    

begin        

a := length(nl, n2);

b := length(n2, n3);

с := length(nl, n3);

p := (а + b + с) / 2;

pi := Sqrt(p * (p - a) * (p - b) *(P - c));

end;   {space}

Begin

         Clrscr;

write('Введите координаты 1-й и 2-й вершин ');

readln(x[l] , у[1], х[2] , у[2]);

i := 2;

su := 0;

repeat

i := i + 1; {Подсчет вершин}

write('Введите координаты ', i, '-и вершины');

readln(x[i] , у[I]) ;

space(l, i - 1, i, pi);

su := su + pi;

until i = n;

writeln(‘Площадь = ', su:10:5);

readln;

End.

 

Составить программу перевода десятичного числа в двоичное.

Program perevod;

Uses Crt;                                            

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;

Вegin { основная программа }

  CIrScr;

  readln( a );

  writeln( DEC_BIN(a) );

  readln;

Еnd.

 

Составить программу перевода двоичного числа в десятичное.

Program perevod2;

Uses Crt;                                            

var a : string;

function BINDEC(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;

   BINDEC:= res;

end;

Вegin { основная программа }

  CIrScr;

  readln( a );

  writeln( BINDEC(a) );

readln;

Еnd.

 

Программа перевода десятичного числа в шестнадцатеричное.

Program perevod3;

Uses Crt;                                            

var a : longint;

function DECHEX(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;

         DECHEX:=res;

     end;

 

Вegin { основная программа }

  CIrScr;

  readln( a );

  writeln( DECHEX(a));

  readln;

Еnd.

 

Программа перевода шестнадцатеричного числа в десятичное.

Program perevod4;

Uses Crt;                                            

var a : string;

function HEXDEC(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;

      HEXDEC:= res;

   end;

Вegin { основная программа }

CIrScr;

  readln( a );

  writeln( HEXDEC(a));

readln;

Еnd.

 

Рекурсивные алгоритмы: нахождения НОД и НОК двух чисел.

Program nodnok;

Uses Crt;                                            

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;

Вegin { основная программа }

     CIrScr;

     write(‘Введите два числа ’);

     readln(a, b);

     writeln( 'НОД этих чисел = ', NOD(a, b) );

     writeln( 'НОК этих чисел = ', NOK(a, b));

     readln;

Еnd.

 

Рекурсивные алгоритмы:  вычисление факториал.

Program factorial;

Uses Crt;                                            

var n: integer;

function f(x: integer): longint;

  begin

     if x = 1 then f := 1 else f := x * f(x-1);

  end;

Вegin

    CIrScr;

     writeln('введите N (N=1..13)');

     readln(n);

     writeln('N!=',f(n));

     readln;

Еnd.

 

Геометрические алгоритмы: Пересекаются ли 2 отрезка?                    

 ------------------------------------------------------------------------

 Определяет пересечение отрезков A(ax1,ay1,ax2,ay2) и B (bx1,by1,bx2,by2),

 функция возвращает TRUE - если отрезки пересекаются, а если пересекаются

 в концах или вовсе не пересекаются, возвращается FALSE (ложь)         

 ------------------------------------------------------------------------

Program line;

Uses Crt;                                             

function Intersection(ax1,ay1,ax2,ay2,bx1,by1,bx2,by2:real):boolean;

var v1,v2,v3,v4:real;

  begin

     v1:=(bx2-bx1)*(ay1-by1)-(by2-by1)*(ax1-bx1);

     v2:=(bx2-bx1)*(ay2-by1)-(by2-by1)*(ax2-bx1);

     v3:=(ax2-ax1)*(by1-ay1)-(ay2-ay1)*(bx1-ax1);

     v4:=(ax2-ax1)*(by2-ay1)-(ay2-ay1)*(bx2-ax1);

     Intersection:=(v1*v2<0) and (v3*v4<0);

  end;

Вegin { основная программа, вызов функции - тест }

   CIrScr;

   writeln(Intersection(1,1,5,5,1,2,3,1)); {test1, yes Intersection}

   writeln(Intersection(1,1,5,5,1,2,1,3)); {test2, no  Intersection}

   readln;

Еnd.

 

Геометрические алгоритмы: Точка внутри сектора или нет?                 

 ------------------------------------------------------------------------

 Если точка внутри сектора (или на сторонах) - TRUE, если нет - FALSE    

 tx,ty - вершина сектора                                                 

 x1,y1,x2,y2 - точки на сторонах сектора                                 

 px,py - точка на плоскости                                                                                                                        

возвращает знак числа, 1 - положительное число, -1 - отрицательное, 0 - 0

------------------------------------------------------------------------

Program inter;

Uses Crt;                                            

function sign(r:real):integer;

  begin

     sign:=0; if r=0 then exit;

     if r<0 then sign:=-1 else sign:=1;

  end;

function InsideSector(tx,ty,x1,y1,x2,y2,px,py:real): boolean;

  var x,y,a1,a2,b1,b2,c1,c2:real;

  var i1,i2,i3,i4:integer;

    begin

       x:=(tx+x1+x2)/3; y:=(ty+y1+y2)/3;

       a1:=ty-y1; b1:=x1-tx; c1:=tx*y1-ty*x1;

       a2:=ty-y2; b2:=x2-tx; c2:=tx*y2-ty*x2;

       i1:=sign(a1*x+b1*y+c1); i2:=sign(a2*x+b2*y+b2);

       i3:=sign(a1*px+b1*py+c1); i4:=sign(a2*px+b2*py+c2);

       InsideSector:=((i1=i3) and (i2=i4)) or ((i1=0) and (i2=i4)) or ((i1=i3) and (i2=0));

    end;

Вegin { основная программа, вызов функции - тест }

CIrScr;

   writeln(InsideSector(1,1,5,1,1,5,3,3)); {test1, yes Inside}

   writeln(InsideSector(1,1,5,1,7,2,3,3)); {test2, no  Intersection}

   readln;

Еnd.

 

Арифметические алгоритмы: возведение целого числа в натуральную степень.

Program chislo;

Uses Crt;                                            

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;

Вegin

    CIrScr;

    writeln('введите число и (через пробел) степень числа');

    readln(x,y);

    writeln(Degree(x,y)); { print x^y }

    readln;

Еnd.