mảng pascal viết ctc in ra các số nt in ra các số hoàn hảo

0 bình luận về “mảng pascal viết ctc in ra các số nt in ra các số hoàn hảo”

1. program oken;
   uses crt;
   type mang = array[1..100] of integer;
   var a: mang;
       n,k: integer;
   function nhap(n: integer; var a: mang):mang;
       var i: integer;
       begin
           for i:=1 to n do
               begin
                   write(‘a[‘,i,’]: ‘);
                   readln(a[i]);
               end;
           nhap:=a;
       end;
   procedure xuat(a: mang;n:integer);
       var i: integer;
       begin
           for i:=1 to n do
               write(a[i],’ ‘);
       end;
   function nt(a: mang;n: integer; var k: integer): mang;
       var i,dem,j: integer;
           b: mang;
       begin
           k:=0;
           for j:=1 to n do
               begin
                   dem:=0;
                   for i:=2 to a[j] do
                           if (a[j] mod i=0) then
                               dem := dem +1;
                   if dem=1 then
                               begin
                                   k:=k+1;
                                   b[k]:=a[j];
                               end;
               end;
           nt:=b;
       end;
   procedure ht(a: mang;n:integer);
       var i,j:integer; s: longint;
       begin
           for i:=1 to n do
               begin
                   s:=0;
                   for j:=1 to (a[i] div 2) do
                       if (a[i] mod j=0) then
                           s:=s+j;
                   if s=a[i] then
                           write(a[i],’ ‘)
               end;
       end;
   begin
       clrscr;
       write(‘Nhap so phan tu cua mang: ‘); readln(n);
       nhap(n,a);
       write(‘Mang vua nhap: ‘);xuat(a,n); writeln;
       write(‘Cac so nguyen to trong day: ‘); xuat(nt(a,n,k),k); writeln;
       write(‘Cac so hoan thien trong day: ‘); ht(a,n);
       readln;
   end.

   Bình luận

2. uses crt;
   var i,n:longint; a:array[1..1000000]of longint;
   function ktnt(a:longint):boolean;
   var i:longint;
   begin
      i:=2;
      while (a>1)and(a mod i<>0) do inc(i);
      ktnt:=i=a;
   end;
   function kthh(a:longint):boolean;
   var i,tong:longint;
   begin
      tong:=0;
      for i:=1 to a div 2 do if a mod i=0 then tong:=tong+i;
      kthh:=tong=a;
   end;
   begin
   clrscr;
      write(‘So phan tu cua mang:’);readln(n);
      for i:=1 to n do
         begin
            write(‘Phan tu thu ‘,i,’: ‘);readln(a[i]);
         end;
      writeln(‘Cac phan tu la so nguyen to: ‘);
      for i:=1 to n do if ktnt(a[i]) then writeln(a[i]);
      writeln(‘Cac phan tu la so hoan hao: ‘);
      for i:=1 to n do if kthh(a[i]) then writeln(a[i]);
   readln
   end.

   ////////////////////////////

   Một số text cho bạn tham khảo:

   

   Bình luận