Câu 8:

uses crt;
var n,i,j,dem,vt,min2,min1:byte;
    a:array[0..150] of byte;
BEGIN
        clrscr;
        write('Nhap n:'); readln(n);
        min2:=1;    {min2 là phần tử lớn nhất trong dãy}

{Nhập dãy số}
        for i:=1 to n  do
        begin
                write('Nhap a[',i,']:');
                readln(a[i]);
                if a[i]>min2 then min2:=a[i];  {TÌM Phần tử lớn nhất trong dãy}
        end;

        min1:=n;    {là số lần xuất hiện ít nhất trong dãy}
        for i:=1 to n do
        begin
                dem:=0;  {là số lần xuất hiện của phần tử đang xét}
                for j:=1 to n do
                        if a[j]=a[i] then inc(dem);
                dec(dem);    {vì mình cho chạy từ 1 đến n nên nó sẽ dư ra 1 lần xuất hiện}
                if (dem<min1) and (a[i]<=min2) then   
                begin
                        min1:=dem;    
                        min2:=a[i];
                        vt:=i;   {lưu lại vị trí}
                end;
        end;
        write('So doc dac la:',a[vt]);
        readln
END.

Bài 3:

uses crt;
var n,i,dem:byte;
a:array[1..255] of integer;
    tam:real;
BEGIN
        clrscr;
        write('Nhap n:'); readln(n);   {Nhập số N}
        for i:=1 to n do
        begin
                write('Nhap a[',i,']:');    {Nhập dãy số}
                readln(a[i]);
        end;
        for i:=1 to n do   {BƯỚC NÀY TÌM XEM CÓ BN SỐ CHÍNH PHƯƠNG}
        begin
                tam:=sqrt(a[i]);    {DÙNG 1 biến tạm = căn bậc hai của số đang xét}
                tam:=round(tam);   {LÀM TRÒN tạm}
                if tam*tam=a[i] then inc(dem);    {NẾU tạm bình phương mà bằng số đang xét thì số đó là số chính phương}
        end;
        write('Co ',dem,' so chinh phuong trong day so tren.');  {GHI RA KẾT QUẢ}
        readln
END.

Chúc bạn học tốt.

Nếu đúng thì cho mik câu trả lời hay nhất nha.

program bai8;

uses crt;

var A:array[1..100] of integer;

      d,min,n,i,j,tg,ptu:integer;

begin

clrscr;

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

write('Nhap so cua tung phieu');

for i:=1 to n do

 begin

  write('Phieu thu ',i,': '); 

  readln(A[i]);

 end;

for i:=1 to n-1 do

 for j:=i+1 to n do

  if A[i]>A[j] then

   begin

    tg:=A[i];

    A[i]:=A[j];

    A[j]:=tg;

   end;

i:=1; min:=1; ptu:=A[1];

while A[i+1]=A[1] do

 begin

  inc(min);

  inc(i);

 end;

while i<=n do

 begin

  d:=1; j:=i+1;

  while A[j]=A[i] do

   begin

    inc(d);

    inc(j);

   end;

   if d<min then

    begin

      min:=d;

      ptu:=A[i];

     end;

   i:=j;

  end;

write(A[i]);

readln

end.