RosettaCodeData/Task/AKS-test-for-primes/ANSI-BASIC/aks-test-for-primes.basic
2025-08-11 18:05:26 -07:00

79 lines
2 KiB
Text

100 REM AKS test for primes
110 DECLARE EXTERNAL SUB PascalTriangle
120 DECLARE EXTERNAL SUB ExpandPoly
130 DECLARE EXTERNAL FUNCTION IsPrime
140 FOR N = 0 TO 9
150 CALL ExpandPoly(N)
160 NEXT N
170 FOR N = 2 TO 50
180 IF IsPrime(N) <> 0 THEN PRINT USING("###"): N;
190 NEXT N
200 PRINT
210 END
220 REM **
230 EXTERNAL SUB PascalTriangle(N, PasTri())
240 REM Calculate t!he N'th line 0.. middle
250 LET N = INT(N)
260 LET PasTri(0) = 1
270 LET J = 1
280 DO WHILE J <= N
290 LET J = J + 1
300 LET K = INT(J / 2)
310 LET PasTri(K) = PasTri(K - 1)
320 FOR K = K TO 1 STEP -1
330 LET PasTri(K) = PasTri(K) + PasTri(K - 1)
340 NEXT K
350 LOOP
360 END SUB
370 REM **
380 EXTERNAL FUNCTION IsPrime(N)
390 LET N = INT(N)
400 DIM PasTri(0 TO 50)
410 LET PasTriMax = UBOUND(PasTri)
420 IF N > PasTriMax THEN
430 PRINT N; "is out of range"
440 STOP
450 END IF
460 CALL PascalTriangle(N, PasTri)
470 LET Res = 1
480 LET I = INT(N / 2)
490 DO WHILE (Res <> 0) AND (I > 1)
500 IF (Res <> 0) AND (MOD(PasTri(I), N) = 0) THEN LET Res = 1 ELSE LET Res = 0
510 LET I = I - 1
520 LOOP
530 LET IsPrime = Res
540 END FUNCTION
550 REM **
560 EXTERNAL SUB ExpandPoly(N)
570 LET N = INT(N)
580 DIM VZ$(0 TO 1)
590 LET VZ$(0) = "+"
600 LET VZ$(1) = "-"
610 DIM PasTri(0 TO 50)
620 LET PasTriMax = UBOUND(PasTri)
630 IF N > PasTriMax THEN
640 PRINT N; "is out of range"
650 STOP
660 END IF
670 SELECT CASE N
680 CASE 0
690 PRINT "(x - 1) ^ 0 = 1"
700 CASE 1
710 PRINT "(x - 1) ^ 1 = x - 1"
720 CASE ELSE
730 CALL PascalTriangle(N, PasTri)
740 PRINT "(x - 1) ^"; N; " = x ^"; N;
750 LET BVZ = 1
760 FOR J = N - 1 TO INT(N / 2) + 1 STEP -1
770 PRINT VZ$(BVZ); PasTri(N - J); "* x ^"; J;
780 LET BVZ = ABS(1 - BVZ)
790 NEXT J
800 FOR J = INT(N / 2) TO 2 STEP -1
810 PRINT VZ$(BVZ); PasTri(J); "* x ^"; J;
820 LET BVZ = ABS(1 - BVZ)
830 NEXT J
840 PRINT VZ$(BVZ); PasTri(1); "* x ";
850 LET BVZ = ABS(1 - BVZ)
860 PRINT VZ$(BVZ); PasTri(0)
870 END SELECT
880 END SUB