bai tap pascal phan 2c

Program Tim_Tuyen_Tinh;
Const
N=10;
Var
a:array[1..N] Of Integer;
so,i:Integer;
Begin
Writeln('GIAI THUAT TIM KIEM TUYEN TINH');
Writeln('------------------------------');
Writeln;
For i:=1 To N Do
Begin
Write('-Phan tu A[',i,']= ');
Readln(a[i]);
End;
Writeln;
Write('-So can tim: ');
Readln(so);
i:=1;
While (i <=N) And (a[i] <> so) Do
i:=i+1;
If i <= N Then
Writeln('+Tim thay o vi tri thu: ',i)
Else
Writeln('+Khong tim thay');
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Tim_Nhi_Phan;
Const
N=10;
Var
a:array[1..N] Of Integer;
so,vt1,vt2,i:Integer;
Begin
Writeln('GIAI THUAT TIM KIEM NHI PHAN');
Writeln('----------------------------');
Writeln;
For i:=1 To N Do
Begin
Write('-Phan tu A[',i,']= ');
Readln(a[i]);
End;
Writeln;
Write('-So can tim: ');
Readln(so);
vt1:=1;
vt2:=n;
While vt2 >= vt1 Do
Begin
i:=Trunc((vt1+vt2) Div 2);
If so > a[i] Then
vt1:=i+1
Else
If so < a[i] Then
vt2:=i-1
Else
vt2:=-1;
End;
If vt2 = -1 Then
Writeln('+Tim thay o vi tri thu: ',i)
Else
Writeln('+Khong tim thay');
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Bo_so_trung;
Const
Max=100;
Var
a:Array[1..Max] Of Integer;
i,j,k,n:Integer;
Begin
Writeln('XOA BO CAC SO TRUNG NHAU');
Writeln('------------------------');
Writeln;
Write('-Nhap so phan tu mang: ');
Readln(n);
For i:=1 To N Do
Begin
Write('-Phan tu A[',i,']= ');
Readln(a[i]);
End;
i:=2;
While i <= N Do
Begin
j:=1;
While a[j] <> a[i] Do
j:=j+1;
If j < i Then
Begin
For k:=i to n-1 Do
a[k]:= a[k+1];
n:=n-1;
End
Else
i:=i+1;
End;
Writeln;
Write('-Mang con lai: ');
For i:=1 to n Do
Write(a[i]:;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Day_con;
Const
k=10;
a:Array[1..k] Of Integer=(1,3,2,8,10,12,7,29,6,3);
Var
i:Integer;
vt,max:Integer;
n,tong:Integer;
Begin
Vt:=1;
max:=a[1];
n:=1;
tong:=a[1];
For i:=2 To k Do
Begin
If (a[i] > a[i-1]) Then
tong:=tong+a[i];
If (a[i] < a[i-1]) Or (i=k) Then
Begin
If tong > max Then
Begin
max:=tong;
vt:=n;
End;
n:=i;
tong:=a[i];
End;
End;
Writeln('-Day con la: ');
i:=vt;
Repeat
Write(a[i]:6);
max:=max-a[i];
i:=i+1;
Until max=0;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Chu_hoa;
Uses Crt;
Const
a:Array[1..10] Of String[24]=('nguyen trung truc','dinh tien hoang',
'nguyen cong tru','le thanh ton','le loi','le lai','tran hung dao',
'nguyen hue','chu van an','mac dinh chi');
Var
k,j:Byte;
{-------------------------}
Procedure ChuHoa(x,y:Byte; a:String);
Var
k:Byte;
Begin
For k:=1 To length(a) Do
If (k=1) Or ((a[k-1]=' ') And (a[k]<>' ')) Then
Begin
GotoXY(x+k-1,y);
Write(UpCase(a[k]));
End;
End;
Begin
ClrScr;
For k:=1 To 10 Do
Begin
GotoXY(5,k);
Write(a[k]:-24);
ChuHoa(5,k,a[k])
End;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Tg_Pascal;
Const
n=10;
Var
a:Array[1..n, 1..n] Of Integer;
i,j:Integer;
Begin
Writeln('TAM GIAC PASCAL');
Writeln('---------------');
Writeln;
For i:=1 To n Do
a[i,1]:=1;
For j:=1 To n Do
a[1,j]:=0;
For i:=2 To n Do
For j:=2 To n Do
a[i,j]:=a[i-1,j-1]+a[i-1,j];
For i:=1 To n Do
Begin
For j:=1 To i Do
Write(a[i,j]:4);
Writeln;
End;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Phan_tich;
Const
n=15;
Var
a:Array[1..n, 1..n] Of Longint;
i,j,i1,j1:Integer;
Begin
Writeln('PHAN TICH SO NGUYEN DUONG NHO NHAT');
Writeln('----------------------------------');
Writeln;
For i:=1 To n Do
For j:=1 To n Do
a[i,j]:=i*i*i + j*j*j;
Writeln;
Writeln('IN KET QUA');
Writeln('----------');
For i:=1 To n Do
For j:=1 To i Do
Begin
For i1:= i+1 To n Do
For j1:=1 To j-1 Do
If a[i,j]=a[i1,j1] Then
Writeln(a[i,j],' = ',i,' ^3 ',' + ',j,' ^3 ',' = ',
i1,' ^3 ',' + ',j1,' ^3');
End;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End.
Program Cuu_Chuong;
Uses Crt;
Type
cc1=Array[1..5, 1..10] Of Byte;
cc2=Array[6..10, 1..10] Of Byte;
Var
i,j:Byte;
Procedure In1;
Var
a:cc1;
cot,hang:Byte;
Begin
cot:=1;
hang:=3;
For i:=1 To 5 Do
For j:=1 To 10 Do
Begin
GotoXY(cot,hang);
a[i,j]:=i * j;
TextColor(Yellow);
Writeln(i:2,' lan ',j:2,' =',a[i,j]:3,'|');
hang:=hang+1;
If hang > 12 Then
Begin
hang:=3;
cot:=cot+15;
End;
End;
End;
Procedure In2;
Var
a:cc2;
cot,hang:Byte;
Begin
cot:=1;
hang:=14;
For i:=6 To 10 Do
For j:=1 To 10 Do
Begin
GotoXY(cot,hang);
a[i,j]:=i * j;
Textcolor(LightMagenta);
Writeln(i:2,' lan ',j:2,' =',a[i,j]:3,'|');
hang:=hang+1;
If hang > 23 Then
Begin
hang:=14;
cot:=cot+15;
End;
End;
End;
BEGIN
ClrScr;
Textcolor(Cyan);
Writeln(' BANG CUU CHUONG');
Writeln(' ---------------');
In1;
Textcolor(LightBlue);
Writeln(' -------------------------------------------');
In2;
Textcolor(LightGreen);
Writeln(' Bam phim <Enter> de ket thuc');
Readln
END.
Program Tim_PT_Mang;
Uses Crt;
Var
a:Array[1..1000] Of Integer;
{----------------------------}
Procedure Tao;
Var
k:Integer;
Begin
Randomize;
For k:=1 To 100 Do
a[k]:=Random(100);
End;
{----------------------------}
Procedure Tim;
Var
k,x:Integer;
Begin
Write('-Nhap gia tri X= ');
Readln(x);
For k:=1 To 999 Do
Begin
If a[k] +a[k+1] = X Then
Writeln('a[',K,'] + a[',K+1,']= ',X)
Else
Writeln('Khong co 2 phan tu nao bang: ',X);
End;
End;
BEGIN
Writeln('TIM 2 PHAN TU LIEN TIEP BANG GIA TRI X');
Writeln('-------------------------------------');
Writeln;
Tao;
Tim;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln;
END.
Program SX_Nhi_Phan;
Uses Crt;
Const
Pt=240;
Type
Mang=Array[1..Pt] Of Integer;
Var
a:Mang;
n:Integer;
{---------------------------------}
Procedure Sort(Var a: Mang; n:Integer);
Var
k,j,dau,cuoi,giua,tam:Integer;
Begin
For k:=2 To n Do
Begin
tam:=a[k];
cuoi:=1;
dau:=k-1;
While cuoi <= dau Do
Begin
giua:=(dau+cuoi) Div 2;
If tam < a[giua] Then
dau:=giua-1
Else
cuoi:=giua+1;
End;
For j:=k-1 Downto cuoi Do
a[j+1]:=a[j];
a[cuoi]:=tam
End
End;
{---------------------------------}
BEGIN
ClrScr;
Randomize;
For n:=1 To Pt Do
a[n]:=Random(1000);
Sort(a,Pt);
For n:=1 To Pt Do
Write(' ',a[n]:6,' ');
Readln
END.