На данной странице публикуются программы,связанные с простыми числами, а также программа нахождения дружественных чисел.

   'Разложение натурального числа на простые множители  на Бэйсике
 CLS
1 INPUT "  N=", n#
  PRINT n#; "=";
  i = 1
  d# = 1
2 d# = d# + i: IF d# > 2 THEN i = 2
 IF d# > SQR(n#) THEN PRINT n#: GOTO 4
3 n# = n# / d#: IF n# = 1 THEN PRINT d#: GOTO 4
  IF n# = INT(n#) THEN PRINT d#; "*"; : GOTO 3
 n# = INT(n# * d# + .1): GOTO 2
4 INPUT "  cont-1"; x
  IF x = 1 THEN 1
  END

примеры разложений:

123456789 = 3*3*3607*3803

9876543212 = 2*2*2469135803

98765432123 =1447*68255309

987654321234567 = 3*3*7*15677052718009

123456789876543 = 3*41152263292181

(Конечно ,чтобы разлагать 15-значные числа в QB, программу желательно компилировать.И то придётся немного подождать.Быстрее считает PASCAL ABC.)

Если кто-то очень не любит оператор GOTO, то можно и без него.

 CLS

1 INPUT "  n="; n#

 PRINT "  "; n#; "=";

 d# = 1

 i = 1

 n0# = n#

 WHILE d# < SQR(n0#)

 IF d# > 2 THEN i = 2

 d# = d# + i

 n# = n# / d#

 IF n# > INT(n#) THEN

 n# = INT(n# * d# + .1)

 ELSE

 PRINT d#;

 IF n# > 1 THEN PRINT "*";

 d# = d# - i

 END IF

 WEND

 IF n# > 1 THEN PRINT n#

 INPUT "    cont-1"; x

 IF x = 1 THEN 1

 программа на ПаскалеABC(c goto)

  program prmn;

   uses crt; 
   label 1,2,3,4;
   var
   n,d:real;
  x,i:integer;
   begin
 1: write( '   n=');
 readln(n);
 write('   n=');
 i:=1;
 d:=1;
 2:d:=d+i;
 if d>2 then i:=2;
 if d>sqrt(n) then
           begin
  write(n);
  goto 4;       
  end;          
 3:n:=n/d;    
 if n=1 then  
       begin
  write(d);
  goto 4;
  end;
  if n=int(n) then
        begin
  write(d,'*');
  goto 3;
  end;
  n:=int(n*d+0.1);
  goto 2;
 4:write('     cont-1');
 readln(x);
 if x=1 then goto 1;
   end.

Конечно на Бейсике запись получается немного короче.

Программа нахождения простых чисел в определённом диапазоне на Паскале:

  program prch;
 uses crt;
 label 1,2,3,4;
 var
 p,n,m,r,c:real;
  d,i:integer;
 begin
 clrscr;
 write('   n0= (нечёт.или 2) ');readln(r);
 if r=1 then r:=2;
  write('   p=');readln(p);
 if r<3 then i:=1 else i:=2;
 n:=r-i;
 1:n:=n+i;
 if n>p then goto 4;
 m:=sqrt(n);
 d:=1;
 2: d:=d+i;
 if d>m then goto 3;
 c:=n/d;
 if(c-int(c)) =0 then goto 1;
 goto 2;
 3: write(' ',  n,' ');{так в ABC,в Turbo - trunc(n)}
 goto 1;
4:end.

 Программа нахождения простых чисел-близнецов на Бэйсике:

   CLS
 'Программа находит пары близнецов в выбранном диапазоне
 'Пара засчитывается,когда полностью входит в диапазон

 INPUT "(нижняя граница- нечётное число >1)"; N
 INPUT "(верхняя граница -нечётное число)"; P
PRINT "близнецы›"
 
20 M = SQR(N)
 D = 1
40 D = D + 2
 IF (D - M) > 0 THEN 100
 C = N / D
 K = C - INT(C)
 IF K = 0 THEN 140
 GOTO 40
100 IF (N - B) = 2 THEN 120
 GOTO 130
120 PRINT B; N; "; "; ,
 E = E + 1
130 B = N
140 N = N + 2

IF (N - P) = 2 THEN 200

GOT0 20

200 PRINT "E =" ; E

END

Нахождение пар дружественных чисел на РascalABC.

 program dj;
 uses crt;
 label 1,2,10,20;
 var
 n,d,c,i,k,r,d1:integer;
 ss,ss1,c1:real;
 begin
 write('n=');
 readln(n);
 for i:=1 to n do
 begin
 if i mod 10000=0 then writeln(i);
 c:=i;
 ss:=1;
 d:=1;
 1:inc(d);
 if d>=sqrt(c) then goto 2;
 if c mod d<>0 then goto 1;
 ss:=ss+d+c/d;
 goto 1;
2:
 c1:=ss;
 ss1:=1;
 d1:=1;
10:inc(d1);
if d1>=sqrt(c1) then goto 20;
 if trunc(c1) mod d1<>0 then goto 10;
 ss1:=ss1+d1+c1/d1;
 goto 10;
 20:if (trunc(ss1)=i) and (i<trunc(c1)) then
 begin
 inc(k);
 writeln (k,':',i,' ',c1);
 end;
 end;
 end.