Pascal: SOLUTIONS BÀI TẬP 6

Program Giai_PT_bac_hai;

uses crt;

var a,b,c,delta:real;

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

Procedure delta_duong;

begin

write('Phuong trinh co hai nghiem x1=',(-b+sqrt(delta))/(2*a),'x2=',(-b+sqrt(delta))/(2*a));

end;

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

Procedure delta_khong;

begin

write('Phuong trinh co nghiem kep x=',-b/(2*a):3:1);

end;

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

Procedure delta_am;

begin

writeln('Phuong trinh vo nghiem');

end;

{Chuong trinh chinh}

Begin

clrscr;

write('Nhap a: ');readln(a);

write('Nhap b: ');readln(b);

write('Nhap c: ');readln(c);

delta:=b*b-4*a*c;

if delta>0 then delta_duong

else if delta = 0 then delta_khong

else delta_am;

readln

end.

Program CTC_1;

uses crt;

var a,b: real;

{----CTC doi gia tri----}

Procedure swap(var x,y:real);

var tam:real;

begin

tam:=x; x:=y; y:=tam;

end;

{-----Ket thuc CTC-----}

begin

clrscr;

write('Nhap so a: ');readln(a);

write('Nhap so b: ');readln(b);

swap(a,b);

write('Sau khi doi a =',a:3:1);

write('Sau khi doi b =',b:3:1);

readln

end.

Program So_lon_nhi;

Var n,i,so, nhi,max,tam:integer;

Procedure swap(var x,y:real);

var tam:real;

begin

tam:=x;

x:=y;

y:=tam;

end;

Begin

    Write('Nhap n: ');Readln(n);

    Write('nhap so:');Readln(max);

    Write('nhap so: ');Readln(nhi);

    if nhi > Max then swap(Max,nhi)

    For i:= 3 to n do

    Begin

         Write('Nhap so: ');Readln(so);

         if (so>nhi) and (so<max) then nhi:=so;

         if so>max then

         Begin

            nhi:=max;

            Max:=so;

         End;

    End;

    Write('So thu nhi la: ',nhi);

    Readln

End.

Program CTC_2;

uses crt;

var n:integer;x:longint;

Procedure Giai_Thua(var GT:longint; n:byte);

begin

    GT:=1;

    while n>0 do

    begin

    GT:=GT*n;

    n:=n-1;

    end;

end;

begin

   repeat

   clrscr;

   write('Nhap so n: ');readln(n);

   if n < 0 then begin write('Nhap so n>=0');readln; end;

   until n>=0;

   Giai_Thua(x,n);

   writeln('Giai thua cua ',n,'la:',x);

   readln

end.

Program Giai_thua_Ham;

uses crt;

var n: longint;

Function Giai_Thua(n:longint):longint;

Var GT:Longint;

begin

     GT:=1;

     while n > 0 do

     begin

     GT:=GT * n;

     n:=n-1;

     end;

     Giai_thua:=GT;

end;

begin

    clrscr;

    write('Nhap n: '); readln(n);

    write(n,'!=',Giai_thua(n));

    readln

end.

Program Rut_gon_phan_so;

uses crt;

var tu,mau:integer;

Function UCLN(a,b:integer):integer;

var r: integer;

begin

     r:= a mod b;

     while r <> 0 do

     begin

         a:= b;

         b:= r;

         r:=a mod b;

     end;

     UCLN:=b;

end;

begin

   clrscr;

   write('Nhap tu: '); readln(tu);

   write('Nhap mau: '); readln(mau);

   write('Ket qua rut gon: ',tu,'/',mau,'=',tu div UCLN(tu,mau),'/',mau div UCLN(tu,mau));

   readln

end.

Program Tron_day;

uses crt;

type kieu_mang =  array[1..100] of integer;

var A, B, C: Kieu_mang;

    n,i,j: integer;

Procedure Nhap_Mang(Var X: Kieu_mang; n:byte);

var i:integer;

begin

    for i:=1 to n do

    begin

        write('M[',i,']=');readln(X[i]);

    end;

end;

Procedure In_Mang(X:kieu_mang; n:byte);

var i: byte;

begin

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

end;

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

begin

   clrscr;

   write('Nhap so phan tu cua day: ');read(n);

   Nhap_mang(A,n);

   Nhap_mang(B,n);

   i:=1;

   j:=1;

   while i<= n do

   begin

        C[j]:=  A[i];

        C[j+1]:=B[i];

        j:=j+2;

        i:=i+1;

   end;

   in_mang(C,2*n);

   readln

end.

Program In_so_nguyen_to;

uses crt;

var  n, i: integer;

{------Ham kiem tra-------}

Function kiem_tra(n:integer):boolean;

var i: integer;

begin

    kiem_tra:=true;

    for i:=2 to n-1 do if (n mod i) = 0 then kiem_tra:=false;

end;

{------CTC----------------}

begin

    clrscr;

    write('Nhap n: '); readln(n);

    for i:=2 to n do if kiem_tra(i) then write(i:3, ', ');

    readln;

end.

Program Sap_xep_day;

uses crt;

type kieu_mang =array[1..100] of integer;

Var A: kieu_mang;

    n,i,j:byte;

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

Procedure Nhap_mang(var M:Kieu_Mang;n:byte);

Var i:byte;

begin

    for i:=1 to n do

    begin

        write('M[',i,']=');readln(M[i]);

    end;

end;

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

Procedure In_mang(var M:Kieu_Mang;n:byte);

Var i:byte;

begin

    for i:=1 to n do write(M[i]:3,', ')

end;

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

Procedure swap(var a,b:integer);

var tam:integer;

begin

    tam:=b;

    b:=a;

    a:=tam;

end;

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

Begin

    Clrscr;

    write('Cho biet so phan tu cua day: ');readln(n);

    nhap_mang(A,n);

    for i:=1 to n-1 do

       for j:= i to n do if A[i]>A[j] then swap(A[i],A[j]);

    In_mang(A,n);

    readln

end.