Найти все делители натурального числа N — Pascal(Паскаль)

{Найти все делители натурального числа N}
program borlpasc;
const kol=100;
type cyfra=0..9;
     chislo=array[1..kol] of cyfra;
var i,r,d,s,k,code:integer;
    j,c0,c1,x,y,z,o,z1,n,lastd:chislo;
    p:boolean;
function  sravnenie(x,y:chislo):integer;
var i,r:integer;
 begin r:=0;i:=1;
       repeat   if (x[i])>(y[i])  then r:=1;
                if x[i]<y[i] then r:=-1;
                i:=i+1;
            until (r<>0)or(i>kol);
            sravnenie:=r;
 end;
procedure add(x,y:chislo;var z:chislo);
var p,a,b,c:integer;
begin p:=0;
      for i:=kol downto 1 do
          begin a:=x[i];
                b:=y[i];
                c:=a+b+p;
                z[i]:=c mod 10;
                p:=c div 10;
          end;
          if p>0 then begin write('переполнение');
                            readln
                      end
end;
procedure sub (x,y:chislo;var z:chislo);
var i,j,p,l,a,b,r,c:integer;
begin p:=0;
      for i:=kol downto 1 do
          begin a:=(x[i]);
                b:=(y[i]);
                c:=a-b+p;
                if c<0 then begin c:=c+10;
	                          p:=-1;
                            end
                       else p:=0;
                z[i]:=(c);
          end;
      if p<0 then begin write('отриц.число');
                        readln
                  end;
end;

procedure Division(x,y:chislo;var z,O:chislo);
var  a,b,r,c,i,j,xt,yt,yt1,s:integer;
     y1:chislo;
begin  z:=C0; o:=x;
       if sravnenie(x,y)=-1 then exit;
       y1:=y;
       yt:=1;while y[yt]=0 do inc(yt);
       xt:=1;while x[xt]=0 do inc(xt);
       s:=yt-xt;yt1:=xt;
       for i:=1 to kol do if i+s<=kol then y1[i]:=y1[i+s]
                                      else y1[i]:=0;
       while yt1<=yt do
             begin r:=0;
                   while not(sravnenie(x,y1)=-1) do
                         begin Sub(x,y1,x);
                               r:=r+1
                         end;
                   for i:=1 to kol-1 do z[i]:=z[i+1];
                   z[kol]:=r;r:=0;
                   for i:=kol downto 2 do y1[i]:=y1[i-1];
                   y1[1]:=0;yt1:=yt1+1;
             end;
       o:=x
end;

procedure print(x:chislo);
var i:integer;
    p:boolean;
begin p:=false;
      for i:=1 to kol do
          begin if x[i]<>0 then p:=true;
                if p then write(x[i])
          end;
      if not(p) then write(0)
end;
procedure input(var x:chislo);
var i,j:integer; s:string;
begin readln(s);
      x:=c0;j:=kol;
      for i:=length(s) downto 1 do
          begin  val(s[i],x[j],code);
                 j:=j-1;
          end;
end;
begin for i:=1 to kol do c0[i]:=0;
      c1:=c0;c1[kol]:=1;
      write('Введите n=');input(n);x:=n;
      j:=c1;add(j,c1,j);k:=0;
      writeln('Делители:');
      writeln(1);p:=true;lastd:=c1;
      while not(sravnenie(x,j)=-1) do
            begin division(x,j,z,o);
                  if sravnenie(o,c0)=0
                     then begin x:=z;
                                if not(sravnenie(lastd,j)=0)
                                   then begin k:=k+1;
                                              lastd:=j;
                                              print(j);
                                              writeln
                                        end
                          end
                     else add(j,c1,j);
            end;
      writeln('Всего ',k+1,' делителей');
      readln
end.

Leave a Comment

− 1 = 1