Tiep ne
----------------------------------------------------DẠNG 2: CÁC BÀI TẬP VỀ MẢNG
1/ NhẬP vào một mảng gồm n số
a/ Kiểm tra xem nảg có đói xứng hay không
b/ Xác định số lần xuất hiện các phần tử trong mảng
c/ Giữ nguyên dãy ban đầu. Tìm dãy con liên tục tăng dần có độ dài dài nhất
d/ Sắp xếp dãy theo thứ tự giảm dần, sau đó nhập vào sô k sao cho thứ tự của dãy vẫn không thay đổ
e/ Chèn phần tử vào mảng
f/Xóa phần tử của mảng
procedure nhap(var a:mang;n:integer);
begin
for i:=1 to n do
begin
writeln( 'a[',i,']=');readln(a);
end;
end;
procedure sapxep(var a:mang;n:integer);
var i,j,tam:integer;
begin
for i:=1 to n-1 do
for j:=i+1 to n do
if a<a[j] then
begin
tam:=a;
a:=a[j];
a[j]:=tam;
end;
writeln('mang sau khi sap xep');
for i:=1 to n do
write('a[',i,']=', a,' ');
readln;
end;
procedure xem(var a:mang;n:integer);
begin
for i:=1 to n do
writeln( 'a[',i,']=',a);
writeln;
end;
procedure ktdx(var a:mang;n:integer);
var kt:boolean;
begin
kt:=true;
for i:=1 to n do
if a<>a[n-i+1] then
begin
kt:=false;
break;
end;
if kt then write('mang dx')
else writeln('mang ko dx');
end;
procedure solanxh(var a:mang;n:integer);
var b:mang; max,min:integer;
begin
max:=a[1];min:=a[1];b[a[1]]:=0;
for i:=2 to n do
begin
b[a]:=0;
if max<a then max:=a;
if min>a then min:=a;
end;
for i:=min to max do b:=0;
for i:=1 to n do b[a]:=b[a]+1;
for i:=min to max do
if b>0 then writeln(i,'xuat hien', b,'lan');
end;
procedure ptxhnln;
var pos,maxlen,dem:integer;
begin
pos:=1;
i:=1;
maxlen:=1;
repeat
dem:=1;
while (a=a[i+1]) and (i<n) do
begin
inc(i);
inc(dem);
end;
if maxlen<dem then
begin
maxlen:=dem;
pos:=i;
end;
inc(i);
until i>=n;
write(a[pos],'xuat hien nhieu nhat la',dem);
end;
procedure ptxh_k_lan;
var pos,maxlen,dem:integer;
begin
i:=1;
repeat
dem:=1;
while (a=a[i+1]) and (i<n) do
begin
inc(i);
inc(dem);
end;
if dem=k then write(a,'xh', k ,'lan');
inc(i);
until i>=n;
end;
procedure daytang(var a:mang;n:integer)
var cmax,dem,dau,cuoi:integer;
begin
cmax:=0;
i:=1;
while i<=n do
begin
dem:=1;
j:=i;
while (a[j]<a[j+1]) and (j<=n) do
begin
dem:=dem+1;
j:=j+1;
end;
if dem>=cmax then
begin
cmax:=dem;
dau:=i;
cuoi:=j;
end;
i:=j+1;
end;
write('day con co tong tang dai nhat');
for i:= dau to cuoi do write(a:4);
end;
Procedure Chen(var a:mang);
Var i,spt:Integer;
so,vitri:Integer;
a:Array[1..100] Of Integer;
Begin
Writeln('MANG TRUOC KHI CHEN');
For i:=1 To n Do
Write(a:6);
Writeln;
Write('-Can che so: ');
Readln(so);
Write('-Vao vi tri: ');
Readln(vitri);
For i:=n+1 Downto Vitri+1 Do
a:=a[i-1];
a[vitri]:=so;
n:=n+ 1;
Writeln;
Writeln('MANG SAU KHI CHEN');
For i:=1 To n Do
Write(a:6);
Readln
End.----
{CHEN MOT SO K VAO MANG DA SAP XEP SAO CHO THU TU KHONG DOI}
Procedure Chen(var a:mang);
Var i,spt:Integer;
so,vitri:Integer;
a:Array[1..100] Of Integer;
Begin
Write('-Can che so: ');
Readln(so);
Vitri:=1;
while (vitri<n) and (a[vitri]>k) then vitri:=vitri+1;
For i:=n+1 Downto Vitri+1 Do
a:=a[i-1];
a[vitri]:=so;
n:=n+ 1;
Writeln;
Writeln('MANG SAU KHI CHEN');
For i:=1 To n Do
Write(a:6);
Readln
End.----
Prcedure Xoa_Pt(var a:mang);
Var i,spt,vitri:Integer;
a:Array[1..100] Of Integer;
Begin
Writeln(' MANG TRUOC KHI XOA');
Writeln(' -----------------');
Writeln;
For i:=1 To n Do
Write(a:6);
Writeln;
Writeln;
Write('-Vi tri muon xoa: ');
Readln(vitri);
For i:=vitri to n - 1 Do
a:=a[i+1];
n:=n - 1;
Writeln;
Writeln(' MANG SAU KHI XOA');
Writeln(' ----------------');
Writeln;
For i:= 1 to n Do
Write(a:6);
Writeln;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc ');
Readln
End;
Nhập mảng, sắp xếp các pt chẵn về đầu mảng, lẽ về cuối mảng
Procedure sx(var:mang;n:integer);
Var
Begin
sx:=1;ex:=n;
while sx<ex do
begin
while (a[sx] mod 2=0 ) and (sx<ex) do sx:=sx+1;
while (a[ex] mod 2=1 ) and (sx<ex) do ex:=ex-1;
if sx<ex then
begin
tg:=a[sx];
a[sx]:=a[ex];
a[ex]:=tg;
end;
ex:=ex-1;sx:=sx+1;
end;
for i:=1 to n do write(a:4);
readln;
End;
Nhập mảng, in ra pt lớn thứ k
Nhấpsắp xếp->in a[k];
BEGIN
write('nhap n: ');readln(n);
nhap(a,n);
xem(a,n);
{ ktdx(a,n);
solanxh(a,n); }
write('nhAp k');readln(k);
sapxep(a,n);
ptxh_k_lan;
readln;
END.