bai tap nang cao phan2b

Program Nhan_so;
Uses Crt;
Const
spt=900;
Type
mang=Array[1..spt] Of Integer;
Var
a,b,c,kq:Mang;
i,j,k,na,nb,tam:Integer;
{---------------------------}
Procedure Nhap(Var a:mang; Var na:Integer);
Var
k:Integer;
Begin
na:=0;
Repeat
na:=na+1;
Write('-Chu so thu: ',na,' = ');
Readln(a[na]);
Until a[na]=-1;
na:=na-1;
For k:=0 To na-1 Do
a[spt-k]:=a[na-k];
For k:=1 to spt-na Do
a[k]:=0;
End;
{---------------------------}
Procedure Cong(a:mang; Var b:mang);
Var
tam1,tam2,k:Integer;
Begin
tam1:=0;
For k:= spt Downto 1 Do
Begin
tam2:=(a[k]+b[k]+tam1) Div 10;
b[k]:=(a[k]+b[k]+tam1) Mod 10;
tam1:=tam2;
End;
End;
{---------------------------}
BEGIN
ClrScr;
Writeln('NHAN 2 SO NGUYEN');
Writeln('----------------');
Writeln;
Writeln('+SO THU NHAT (-1 de ket thuc) ');
Nhap(a,na);
ClrScr;
Writeln('+SO THU HAI (-1 de ket thuc) ');
Nhap(b,nb);
For k:=1 To spt Do
kq[k]:=0;
For j:=spt Downto spt-nb Do
Begin
For k:=1 to spt Do
c[k]:=0;
tam:=0;
For i:=spt Downto spt-na Do
Begin
c[j+i-spt]:=(b[j]*a[i]+tam) Mod 10;
tam:=(b[j]*a[i]+tam) Div 10;
End;
Cong(c,kq)
End;
ClrScr;
Writeln('KET QUA NHAN 2 SO NGUYEN');
Writeln('-----------------------');
Writeln;
Write('*So thu nhat: ');
For k:=spt-na+1 To spt Do
Write(a[k],' ');
Writeln;
Write('*So thu hai : ');
For k:=spt-nb+1 To spt Do
Write(b[k],' ');
Writeln;
Write('*Tich = ');
For k:=Spt-(na+nb)+1 To spt Do
Write(kq[k],' ');
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
END.
Program Ma_tran_vuong;
Uses Crt;
Var
a:Array[1..10, 1..10] Of Integer;
i,j:Integer;
Begin
Writeln('MA TRAN VUONG 10 x 10 PHAN TU');
Writeln('-----------------------------');
ClrScr;
Window(10,5,60,25);
For i:= 1 To 10 Do
Begin
For j:=1 To 10 Do
Begin
If i=j Then
a[i,j]:=i
Else
a[i,j]:=0;
Write(a[i,j]:5);
End;
Writeln(#10)
End;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Tim_so;
Var
a:Array[1..4,1..6] Of Integer;
i,j,so,solan:Integer;
Begin
Writeln('TIM MOT SO TRONG MANG');
Writeln('---------------------');
Writeln;
For i:=1 To 4 Do
For j:=1 to 6 Do
Begin
Write('-Phan tu A[',i,',',j,']= ');
Readln(a[i,j]);
End;
Writeln;
Write('-So muon tim: ');
Readln(so);
solan:=0;
For i:=1 To 4 Do
For j:=1 To 6 Do
If so=a[i,j] Then
Begin
solan:=solan+1;
Writeln('+Lan: ',solan,' tai hang: ',i,' cot: ',j);
End;
Writeln;
Writeln('+Tong so lan xuat hien la: ',solan);
For i:=1 To 4 Do
Begin
For j:=1 To 6 Do
Write(a[i,j]:;
Writeln;
End;
Readln
End.
Program Giai_he_PT_tuyen_tinh;
Var
A:Array[1..2, 1..2] Of Real;
C:Array[1..2] Of Real;
x,y,dt,dtx,dty:Real;
i,j:Integer;
Begin
Writeln('GIAI HE PT TUYEN TINH 2 AN');
Writeln('--------------------------');
Writeln;
Writeln('-Nhap cac he so A cua he phuong trinh: ');
For i:=1 to 2 Do
For j:=1 To 2 Do
Begin
Write('+Phan tu A[',i,',',j,']= ');
Readln(a[i,j]);
End;
Writeln;
Writeln('-Nhap cac he so C cua he phuong trinh: ');
For i:=1 to 2 Do
Begin
Write('+Phan tu C[',i,']= ');
Readln(c[i]);
End;
Writeln;
{Giai he phuong trinh}
Dt:= a[1,1]*a[2,2]-a[1,2]*a[2,1]; {Dt: Dinh thuc}
Dtx:=c[1]*a[2,2]-c[2]*a[2,1];
Dty:=a[1,1]*c[2]-a[1,2]*c[1];
If Dt <> 0 Then
Begin
x:=Dtx / Dt;
y:=Dty / Dt;
Writeln('X= ',x);
Writeln('Y= ',y);
End
Else
Begin
If (Dtx=0) And (Dty=0) Then
Writeln(#7,#7,#7,' Co vo so nghiem')
Else
Writeln(#7,#7,#7,'Vo nghiem');
End;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Nhan_ma_tran;
Const
Max=10;
Type
Matran=Array[1..Max,1..Max] Of Integer;
Var
A,B,C:Matran;
hang1,cot1,i,j,m,n,q:Integer;
Begin
Writeln('NHAN MA TRAN');
Writeln('------------');
Writeln;
Writeln('MA TRAN A:');
Write('-So hang = ');
Readln(m);
Write('-So cot = ');
Readln(n);
For i:=1 To m Do
For j:=1 To n Do
Begin
Write('+Phan tu A[',i,',',j,' = ');
Readln(a[i,j]);
End;
Cot1:=m;
Hang1:=m;
Writeln;
Writeln('MA TRAN B:');
Write('-So hang = ');
Readln(m);
Write('-So cot = ');
Readln(n);
For i:=1 To m Do
For j:=1 To n Do
Begin
Write('+Phan tu B[',i,',',j,' = ');
Readln(b[i,j]);
End;
For i:=1 To Hang1 Do
For j:=1 To n Do
Begin
c[i,j]:=0;
For q:=1 To Cot1 Do
c[i,j]:= c[i,j] + a[i,q] * b[q,j];
End;
For i:=1 to hang1 Do
Begin
For j:= 1 To n Do
Write((c[i,j]):;
Writeln;
End;
Readln
End.
Program Tong_Tich_Ma_tran;
Uses Crt;
Type
Matran=array[1..3,1..3] Of Integer;
Var
a,b,c,d:Matran;
i,j,k:Byte;
Ch:Char;
{*****************************}
Procedure Nhap(Var m:Matran; Ten:Char);
Begin
ClrScr;
GotoXY(26,6);
Write('-Nhap ma tran: ',Ten);
For i:=1 To 3 Do
For j:=1 to 3 Do
Begin
GotoXY(20*i-8,10+2*j);
Write(Ten,'[',i,',',j,']= ');
Readln(m[i,j]);
End;
End;
{*****************************}
Procedure Xuat(m:Matran; Ten:Char);
Begin
ClrScr;
GotoXY(26,6);
Write('CAC PHAN TU CUA MA TRAN: ',Ten);
For i:=1 To 3 Do
For j:=1 To 3 Do
Begin
GotoXY(20*i-8,10+2*j);
Write(Ten,'[',i,',',']= ',m[i,j]);
End;
End;
{*****************************}
BEGIN
Nhap(a,'A');
Nhap(b,'B');
For i:=1 To 3 Do
For j:=1 To 3 Do
c[i,j]:=a[i,j]+b[i,j];
Writeln;
Writeln('MA TRAN TONG');
Writeln;
Xuat(c,'C');
GotoXY(10,25);
Write('Bam phim <Esc> de xem ma tran tich');
For i:=1 to 3 Do
For j:=1 To 3 Do
Begin
d[i,j]:=0;
For k:=1 To 3 Do
d[i,j]:=a[i,k]*b[k,j]+d[i,j];
End;
Repeat
Ch:=Readkey;
If Ch=#0 then
Ch:=Readkey;
Until Ch=#27;
Writeln('MA TRAN TICH= ');
Xuat(d,'D');
Repeat
Until KeyPressed;
END.
Program Mang_tang;
Const
Max=10;
Var
a:Array[1..Max] Of Integer;
i,j,tam:Integer;
Begin
Writeln('SAP XEP MANG TANG DAN');
Writeln('---------------------');
Writeln;
For i:= 1 To Max Do
Begin
Write('-Phan tu A[',i,']= ');
Readln(a[i]);
End;
For i:=1 to Max-1 Do
For j:= i+1 To Max Do
Begin
If a[i] > a[j] Then
Begin
tam:=a[i];
a[i]:=a[j];
a[j]:=tam;
End;
End;
Writeln;
Writeln('+Mang sau khi sap xep:');
Writeln;
For i:=1 To Max Do
Write(a[i],' ');
Writeln;
Readln
End.
Program Gt_Chen;
Const
spt=10;
Var
a:array[1..spt] Of Integer;
i,j,k,tam:Integer;
Begin
Writeln('SAP XEP MANG BANG GIAI THUAT CHEN');
Writeln('---------------------------------');
Writeln;
For i:=1 To spt Do
Begin
Write('-Phan tu A[',i,']= ');
Readln(a[i]);
End;
For i:=2 To spt Do
If a[i] < a[i-1] Then
Begin
j:=1;
While a[j] < a[i] Do
j:=j+1;
tam:=a[i];
For k:=i Downto j+1 Do
a[k]:=a[k-1];
a[j]:=tam;
End;
Writeln;
Writeln('Mang sau khi sap xep:');
For i:=1 To spt Do
Write(a[i]:6);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Gt_Chon;
Const
spt=10;
Var
a:array[1..spt] Of Integer;
min,vitri,i,j:Integer;
Begin
Writeln('SAP XEP MANG BANG GIAI THUAT CHON');
Writeln('---------------------------------');
Writeln;
For i:=1 To spt Do
Begin
Write('-Phan tu A[',i,']= ');
Readln(a[i]);
End;
For i:=1 To spt Do
Begin
min:=a[spt];
vitri:=spt;
For j:=i To spt Do
If a[j] < min Then
Begin
min:=a[j];
vitri:=j;
End;
a[vitri]:=a[i];
a[i]:=min;
End;
Writeln;
Writeln('Mang sau khi sap xep:');
For i:=1 To spt Do
Write(a[i]:6);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Gt_Noi_bot;
Const
spt=10;
Var
a:array[1..spt] Of Integer;
i,j,tam:Integer;
Begin
Writeln('SAP XEP MANG BANG GIAI THUAT NOI BOT');
Writeln('-----------------------------------');
Writeln;
For i:=1 To spt Do
Begin
Write('-Phan tu A[',i,']= ');
Readln(a[i]);
End;
For i:=1 To spt-1 Do
For j:= spt Downto i+1 Do
If a[j] < a[j-1] Then
Begin
tam:=a[j];
a[j]:=a[j-1];
a[j-1]:=tam;
End;
Writeln;
Writeln('Mang sau khi sap xep:');
For i:=1 To spt Do
Write(a[i]:6);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.