Programowanie Pascal

[ostatnia aktualizacja 2007.01.31 22:42:21 ]

program srednia_min_max;
uses crt;
var
    i, min, max, a, b, c : integer;
    s : real;
    ch : char;

begin
    writeln('podaj ilosc liczb');
    readln(a);
    if a <= 0 then halt;
    c := 0;

    for i:=1 to a do
    begin
        writeln('podaj liczbe');
        readln(b);
        c := c + b;
        if i = 1 then
        begin
            min := b;
            max := b;
        end;
        if b > max then max := b;
        if b < min then min := b;
    end;

    s:=c/a;

    writeln('srednia:',s:6:3);
    writeln('min:',min);
    writeln('max:',max);

    ch:=readkey;
end.

Rozwiązywanie układów równań liniowych z 3 (trzema) niewiadomymi.

program rownania_liniowe_3_niewiadome;
uses crt;
var a11, a12, a13 : real;
    a21, a22, a23 : real;
    a31, a32, a33 : real;
    b1, b2, b3 : real;
    x1, x2, x3 : real;
    m_det : real;
    x1_det, x2_det, x3_det : real;
    Ch : Char;

function det (var a, b, c, d, e, f, g, h, i : real) : real;
begin
  det := a*e*i + d*h*c + b*f*g - c*e*g - b*d*i - h*f*a;
end;

Begin
     clrscr;
     WriteLn('Program do rozwiazywania rownan z trzema niewiadomymi');

     WriteLn('Podaj klejno wspolczynniki rownania 1: ');
     Read(a11, a12, a13, b1);

     WriteLn('Podaj klejno wspolczynniki rownania 2: ');
     Read(a21, a22, a23, b2);

     WriteLn('Podaj klejno wspolczynniki rownania 3: ');
     Read(A31, A32, a33, B3);

     m_det  := det(a11, a12, a13, a21, a22, a23, a13, a23, a33);

     x1_det := det(b1, a12, a13, b2, a22, a23, b3, a23, a33);
     x2_det := det(a11, b1, a13, a21, b2, a23, a31, b3, a33);
     x3_det := det(a11, a12, b1, a21, a22, b2, a31, a32, b3);

     if M_det <> 0.0 then
       Begin
         x1 := x1_det / m_det;
         x2 := x2_det / m_det;
         x3 := x3_det / m_det;
         WriteLn('Rozwiananiem sa liczby');
         WriteLn('x1=',x1:10:2,' x2=',x2:10:2,' x3=',x3:10:2)
       end
     else
       If  (x1_det <> 0.0) or  (x2_det <> 0.0) or (x3_det <> 0.0) then
         WriteLn('Uklad sprzeczny')
       Else
         WriteLn('Nieskonczenie wiele rozwiazan');

       Ch := Readkey
End.

Silnia iteracyjnie i rekurencyjnie

program silnia_potega;
uses crt;

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

function silniaIter (n : integer) : longint;
var
    aux : longint;
    i : byte;
Begin
    aux := 1;
    for i := 2 to n do
        aux := aux * i;
    silniaIter := aux;
end;

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

function silniaRek (n : integer)  : longint;
var 
    aux : longint;
    i : byte;

Begin
    aux:=1;
    if n = 1 then
        silniaRek := 1
    else
        silniaRek := n * silniaRek(n-1);
end;

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

var
    k : char;
    n : longint;
    ch : char;
begin
    clrscr;
    writeln ('podaj liczbe ');
    readln(n);
    begin
        writeln('silnia iteracyjne:    ', silniaIter(n));
        writeln('silnia rekurencyjnie: ', silniaRek(n));
    end;
    k := readkey;
end.

Robi się :)

Komentarze internautów

Brak komentarzy

Dodaj własny komentarz czy podpowiedź