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.