  100REM > :4.$.DonMcD.Calc.SERIcalc4S
  110MODE 7
  120FOR D= 1 TO 2 : PRINT CHR$(131) CHR$(141)  "BBC BASIC V/64 PROGram  ""SERIcalc4S""" : NEXT D
  130PRINT '"22/4/93, 3.05.98 div-mod, print enable "
  140PRINT "(spool) 30.09.01 , 4.1.03"'" REPEAT MOD N, MULTIPLES/SUBMULT."'"DISP HEX AND BASE 27, A-Z."'"v. economical apprxn., sum squares."
  150    PRINT "powers 10^308, 40-th mers. PHI, 2.1.04"'"now "TIME$
  160*FX 21, 0
  170PRINT 'CHR$(131) "SERIcalc4S, Seri(ous) MATHS-SCIENCE- " ' "  Ser(ial) CALCULATOR," ' " with number theory functions"' "Plus+  OPTIONAL RUNNING PRINT/OUT"'
  180PRINT 'CHR$(131) "(c) By Don.McDonald@paradise.net.nz,"'" WLGTN2, New ZLD."
  190PRINT ' " 63 / *3 Hut chi son Road" ' "Wellington 2, New Zealand." ' "    Phone 64-4- 389-6820."
  200REM PRINT "Price negot. NZ$120.00"
  210REM PRINT ' "MAINTENANCE MESSAGES &" ' "  ASSOCIATED PROGRAMS.  ";
  220   basic$ = REPORT$    :  REM   PRINT basic$
  230PRINT CHR$(131)  "Set CAPS Lock, Contin, Press any Key.  ";FNCONT
  240
  250WHILE FALSE
  260PRINT ' "MAINTENANCE MESSAGES."'' " advanced from  PTOCalc, PTObasv. " ' " USING CASE OF WHEN " ' "to swap Quotient - Remainder"'" (Integer DIV-MOD)" ' "Combinations up to n = 1024+ " ' "Factorials up to 170 !. "
  270PRINT"Calculate Order of group " ' "(and Period of decimal fraction"'" 1/7 th etc. )" ' "Order can be the slowest calculation" ' "  especially for group 3,838,381. "
  280PRINT "List common Basic FN Keywords, ?"
  290PRINT '"Continued Fraction also calculates"'"   rational approximations."
  300PRINT' "Poisson Distribution Probability" ' "Divisors"
  310  PRINT "CHECK/SET PRINT NUMERIC FORMAT, @%= " ' "PERCENT  %"
  320  PRINT "EXPRESS INTEGER AS SUM OF 2 SQUARES. (E.G. 801,125 IN 16 WAYS)"
  330PRINT FNCONT
  340
  350PRINT'"ASSOCIATED PROGRAMS, " '' " BEEBLET, NEWSLETTER OF BBC/ACORN"' " COMPUTER USER GROUP NZ INC.,"'" PO BOX 45-106, EPUNI, WELLINGTON."'"1988-92."'' "  PRIMES UP TO 5.3 MILLION"
  360
  370PRINT"(ARCHIMEDES 900 MILLION, SIEV7." '' "PRIMES AND FACTORS.  (FACTORS.)" '' "CONTINUED FRACTIONS, A CODE FOR"'"SCRAMBLING YOUR PIN NUMBER ETC."'"  EUCLID,   CTDFRAC, ANTHYPHAIRESIS."''"STATISTICS  (PLOTY-X),  " '' FNCONT
  380  PRINT "PROFILE,  SUMSQS, THE Bridge BBS:"'" 27xPD-pgms, Wright JJ, 81 kb. 64+4+ 568 2662/ old 801-5898." '
  390PRINT'"A SIMPLE CALCULATOR (INCLUDING MATH" ' " FUNCTIONS AND PARENTHESES) CAN BE MADE" ' " ON ONE FUNCTION KEY BY"'"* KEY 8 I.R:REP.:I.SPC4; A$:A$=STR$(R)+A$:R=EVAL(A$):PRINT""= "";R;:U. FA. |M" ''
  400
  410ENDWHILE
  420
  430DIM RES(1000) : RECALL = 0
  440DIM H%(1000)   : REM PROC ORDER
  450RES = TIME : PHI = (SQR5+1)/2: phi = PHI : PROCENABLE
  460ON  ERROR PRINT CHR$(131);   REPORT$  " at line. ";ERL
  470VDU 15
  480
  490PRINT ' CHR$(7) "DISP INSTRUCTNS  Yy  (default N), Q. END ?";
  500   : V$ = GET$: PRINT;V$
  510   : IF V$  ="Y" OR V$ = "y" THEN PRINT"YES.  "  basic$  ELSE PRINT " NO."
  520IF V$ = "Q" OR V$="q" THEN   PROCEND
  530REPEAT
  540   INPUT '"BEGIN, ENTER START NUMBER (Expression),  Q. END" ';A$   : REM wish to force all sm letrs to CAPS. ' "  default Return," 
  550   IF A$ = "Q" OR A$ ="q" THEN  PROCEND
  560   IF LEN A$ > 0 THEN RES = EVAL A$
  570   IF V$ = "Y" OR V$ = "y" THEN PRINT'"BUILD ON TO RES NEXT CALCULATION STEP,"'"E.G. + .., *, /, -, ^"' "Previous Reslt(s)=RES(.),"'"O. OPTIONS (CAP letter functns), ?HELP"'" N.new, <Return> display, Q.END ."'
  580
  590   PROCRSLT(RES)
  600   A$ = GET$
  610   WHILE  A$ <> "N" AND A$ <> "n"
  620           IF A$ = "Q" OR A$ = "q" THEN PROCEND
  630           IF ASC A$ = 13 THEN A$ = ","  : REM "ENTER" KEY WILL CAUSE ","   WANT TO DISPLAY (COMMAS X 3 DIGIT GROUPS.)
  640
  650CASE A$ OF
  660
  670WHEN "O" , "o"
  680
  690PRINT''CHR$(131)"O.PTIONS: R.ECIPR, I.NTEG, G.FRACTION"'"v.SQROOT, L.OGS, X.EXP, T. 10^, A.Order"'"!.FACTORIAL, F.ACTOR, S.CHG SIGN +/-"'"E.ADD EXPONENT, M.OD, P.ERMUTE, C.OMBIN"'CHR$(131)" N.EW START, H.C.F., W. CTD FRACN,"
  700PRINT"B.PRT ON/OFF, D.IVISORS,  Z. NXT PRIME"'"_DELETE UNIT, ()[].RECALL,  % PERCENT"' "& INPUT HEX NOS., ~DISP HEX TILDA ,"'"U. POISSON DISTN PROB, J. multiples"
  710   PRINT CHR$(131)"Q. END,  <ESCAPE>, <CR>,Commas, ?.HELP"  '"' rem,  @ PRINT FORMAT, Y. Roots/Powers,"'"<> = + - * / , BASIC OPERATORS,"' "K. EXPRESS AS SUM OF 2 SQUARES."
  720
  730WHEN   ""  ,  ","    : REM A$ = GET$ APPEARS NOT TO CAUSE NULL STRING, BUT ASC 13.    (IF ASC A$ = 13 REPLACES BY ",". )
  740PROCOMMA   :  REM  SUPERSEDES PROCDISP, PROCED 23.6.93 :
  750:
  760WHEN "R" , "r"
  770PROCRECIP
  780
  790WHEN "I" , "i"
  800PROCINTEG
  810
  820WHEN "G"  , "g"
  830PROCGFRAC
  840
  850WHEN "V"  , "v"
  860PROCSQROOT
  870
  880WHEN "B"  , "b"
  890PROCENABLE
  900
  910WHEN "_"
  920PROCUT
  930
  940WHEN "L" , "l"
  950PROCLOG
  960
  970WHEN "Y", "y"
  980PROCRoots_Powers
  990
 1000WHEN "X" , "x"
 1010PROCEXPN
 1020
 1030WHEN "T" , "t"
 1040PROCTENTO
 1050
 1060WHEN "!"
 1070PROCFACTORIAL
 1080
 1090WHEN "F" , "f"
 1100PROCFACTORS
 1110
 1120WHEN "S" , "s"
 1130PROCHGSIGN
 1140
 1150WHEN "E" , "e"
 1160PROCE38
 1170
 1180   WHEN  "%"
 1190        PROCPERCENT
 1200
 1210WHEN "M" , "m"
 1220PROCMOD
 1230
 1240WHEN "P" , "p"
 1250A$ = "P"
 1260PROCPERMUTN
 1270
 1280WHEN "C" , "c"
 1290A$ = "C"
 1300PROCPERMUTN    : REM INCLUDES COMBIN
 1310
 1320WHEN "H" , "h"
 1330PROCHCF
 1340
 1350WHEN "W" , "w"
 1360REM  PROCVGENT  (SUPERSEDED)
 1370PROCTDFRAC93
 1380
 1390WHEN "D" , "d"
 1400PROCDIVISORS
 1410
 1420WHEN "Z"  , "z"
 1430PROCFODPR
 1440
 1450WHEN "("  , ")"   , "[" , "]"
 1460PROCRECALL
 1470
 1480WHEN "A" , "a"
 1490PROCORDER
 1500:
 1510WHEN "U" , "u"
 1520PROCPOISSON
 1530
 1540WHEN "~"
 1550PROCHEX
 1560
 1570WHEN "?"
 1580PROCHELP   : REM  KEYWORDS
 1590
 1600WHEN "'"      :  REM  APOSTROPHE REMARK
 1610INPUT "rem. "; B$
 1620
 1630  WHEN "@"
 1640  PRINT' "CURRENT PRINT FORMAT, @% decimal = "; @%  " @% hex = &"; ~@%
 1650  INPUT ' "PRESS RETURN, OR ENTER NEW FORMAT"'"STANDARD 2314 DECIMAL, &90A HEX  "; F$
 1660  IF F$ = "" THEN PRINT "FORMAT UNCHANGED"  ELSE PRINT "FORMAT RESET " : @% = EVAL F$
 1670
 1680WHEN "K",  "k"  :  REM  SUM OF SQUARES
 1690PROCSUMSQS
 1700  WHEN "J", "j" : PROCmultiples
 1710
 1720OTHERWISE
 1730PRINT;A$; :  INPUT; B$
 1740A$ = STR$(RES) + A$ + B$
 1750RES = EVAL(A$)
 1760
 1770
 1780ENDCASE
 1790VDU 15
 1800  PROCRSLT(RES)  : REM UPDATE DISPLAY RESULT LINE, 24.6.93
 1810        A$ = GET$
 1820        ENDWHILE
 1830  UNTIL A$ = "Q"   OR A$ = "q"
 1840PROCEND    :  END
 1850DEF PROCEND
 1860PRINT''CHR$7 "Q. PROGRAM  SERIcalc4S  E N D."
 1870PRINT CHR$(131);  :INPUT "CONFIRM QUIT -ENTER <CR>," ' "or  RESUME PRESS <esc>,  "; G$
 1880   PRINT  "PRT & SPOOL OFF": VDU 3
 1890*SPOOL
 1900REM  ?? CLOSE #0 :  P. "CLOSE #0,  ALL.??"
 1910STOP
 1920REM ===================================:
 1930
 1940DEF PROCRSLT(RES)   : REM DISPLAY UPDATE RES / RESULT LINE, 24.6.93
 1950RECALL = (RECALL + 1) MOD 1000 : RES(RECALL) = RES
 1960PRINT"(";RECALL") " RES ; SPC 2; : REM   A$= STR$(RES)
 1970ENDPROC
 1980
 1990DEF PROCDISP     : REM SIMPLE VERSION, SUPERSEDED BY EXTENDED PROCOMMA DISPLAY COMMA'S, C. 22.6.93
 2000B$ = STR$(RES)
 2010FOR I = 1 TO LEN(B$) STEP 3
 2020PRINT MID$(B$, I, 3)",";
 2030NEXT I
 2040PRINT
 2050ENDPROC
 2060:
 2070DEF PROCRECIP
 2080PRINT"RECIPROCAL"
 2090RES= 1/RES
 2100ENDPROC
 2110:
 2120DEF PROCINTEG
 2130PRINT"INTEGER PART"
 2140RES = INT(RES)
 2150ENDPROC
 2160:
 2170DEF PROCGFRAC
 2180PRINT"GFRACTION PART"
 2190GF = RES - INT(RES)
 2200PRINT "(  INTEG PART FIRST = ";
 2210PROCRSLT(INT(RES) )
 2220PRINT ' "FRACTION (DECIMAL) PART = "
 2230RES = GF
 2240ENDPROC
 2250:
 2260DEF PROCSQROOT
 2270PRINT"SQUARE ROOT, v"
 2280RES = SQR(RES)
 2290ENDPROC
 2300:
 2310DEF PROCENABLE
 2320PRINT   CHR$(7)''"HARD COPY PROVISIONS."''  "HIT B. PRT ON, C. PRT OFF,"'" * Spool SPSeriCALC."
 2330  PRINT" (REM A LOG OF PRINTOUT CAN ALSO"'" BE OBTAINED BY RUNNING SERIcalc4"'" IN A TASK WINDOW AND SAVING" '"TEXT UNDER !EDIT."'
 2340CASE GET$ OF
 2350   WHEN "B"  , "b"
 2360   VDU 2 : PRINT"PRINT ON"
 2370
 2380   WHEN "C"  , "c"
 2390   VDU 3 : PRINT"PRINT OFF"
 2400
 2410   WHEN  "*"
 2420   PRINT '' "*SPOOL  ram CALCDATA.SPSERICALC  ON UNTIL Q = END CLOSE"  '' CHR$(7)
 2430   VDU 7  :  *ram
 2440  *SPOOL SpSeriCalc
 2450
 2460   ENDCASE
 2470ENDPROC
 2480:
 2490DEF PROCLOG
 2500INPUT"LOGARITHM,"'" ENTER BASE e, E" ' "or +VE NO. expr, ( DEFAULT=10) ,";BASE$
 2510IF BASE$ = "E" OR BASE$ = "e" THEN
 2520   PRINT"LN = "; : RES = LN(RES)
 2530ELSE
 2540        IF BASE$ = "" THEN B = 10  ELSE B = EVAL BASE$ :
 2550        PRINT "LOG (BASE "; B ")  = "
 2560RES = LN(RES) / LN ( B) : REM BASE > 0
 2570ENDIF
 2580  ENDPROC
 2590:
 2600DEF PROCRoots_Powers
 2610x= RES     : Lx = LN x / LN 2
 2620y=0
 2630PRINT CHR$ 131 "Optn Y "' CHR$ 131 ": disp Roots x^(1/y),& powers x^y."'
 2640REPEAT  y += 1
 2650PRINT; y"        "x^(1/y);
 2660IF ABS(y*Lx) < 1024 THEN PRINT "     "; x^y ELSE PRINT
 2670IF (y MOD 8 ) = 3 THEN PRINT CHR$ 7 CHR$ 131 "index y |  x^(1/y)  |    x^y     "' CHR$ 131 ": x=";x  "   CONT <ESC>."GET$
 2680
 2690UNTIL FALSE
 2700ENDPROC
 2710
 2720DEF PROCEXPN
 2730PRINT"EXP,  e ^ x" : RES = EXP(RES)
 2740ENDPROC
 2750:
 2760DEF PROCTENTO
 2770PRINT"ANTILOG,  10 ^ ";RES
 2780RES = 10 ^ RES
 2790ENDPROC
 2800:
 2810DEF PROCFACTORIAL
 2820PRINT"! FACTORIAL ";
 2830  IF ABS(RES) > 170 THEN
 2840        PRINT ';RES "  NEEDS STIRLING'S  LN(X!)" ' " FORMULA > 1E308 FOR GAMMA FUNC" ' " TO EXTEND PROCEDURE."
 2850        ELSE
 2860
 2870X=INT RES  : PRINT;X
 2880: RES=1
 2890WHILE X > 1
 2900   RES= RES * X
 2910   X = X - 1
 2920   ENDWHILE
 2930        ENDIF
 2940ENDPROC
 2950:
 2960DEF PROCFACTORS
 2970PRINT"LEAST PRIME FACTOR"
 2980  IF RES < 1 THEN PRINT "NO. IS LESS THAN 1. PLEASE MAKE +VE >= 1."  : ENDPROC
 2990  IF RES > 2^31 -1 THEN PRINT "RES EXCEEDS INTEGER RANGE, MAX 2^31 -1" : ENDPROC
 3000  RES = INT RES  : REM FORCE INTEGER
 3010IF RES < 4 THEN  PRINT "PRIME" : ENDPROC
 3020IF RES MOD 2 = 0  THEN RES = RES DIV 2 : PRINT;2 "  *  "; : ENDPROC
 3030F%=1 : RT% =SQR(RES) :
 3040   REPEAT
 3050F%= F%+2 : UNTIL RES MOD F% = 0 OR F% > RT%
 3060IF F% > RT% THEN PRINT"PRIME  "; : ENDPROC
 3070RES = RES DIV F% : PRINT;F% "  *  ";
 3080ENDPROC
 3090:
 3100DEF PROCSTIRLING         :  REM TO RESURRECT (24.6.93) FOR GAMMA FUNCN
 3110
 3120PRINT"STIRLING APPROXMATN TO FACTORIAL, PSE INCLUDE +1/12N -1/360N3 +1/1260N5"
 3130RES = RES ^ RES * EXP(-RES) * SQR( 2*PI*RES)
 3140ENDPROC
 3150:
 3160DEF PROCHGSIGN
 3170PRINT"CHANGE SIGN +/-"
 3180RES = -RES
 3190ENDPROC
 3200:
 3210DEF PROCE38
 3220INPUT"*10^n"; NE
 3230RES = RES * (10^NE)
 3240ENDPROC
 3250:
 3260  DEF PROCPERCENT  : REM  ADDED 24.6.93
 3270  PRINT"%,  PERCENT"
 3280  RES = .01 * RES
 3290  ENDPROC
 3300
 3310DEF PROCMOD
 3320INPUT "MOD-DIV$(REPEAT N)"'"-ve closest modulus, ";N$  :  N = INT( EVAL( N$ ))
 3330       PRINT "modulus  "N$  "= ";  N
 3340       IF N < 1 THEN
 3350          QUOTNT = INT(- RES/ N +.5)
 3360          RIEMANDER = RES + N * QUOTNT
 3370          ELSE
 3380REM  PRINT "( QUOTIENT , REMAINDER  : ) "
 3390QUOTNT = RES DIV N  : RIEMANDER = RES MOD N
 3400     ENDIF
 3410PRINT "QUOTIENT=";
 3420PROCRSLT(QUOTNT)
 3430PRINT ' "REMAINDER(E,x10^n)=";
 3440REM  PROCRSLT(RIEMANDER)
 3450
 3460RES = RIEMANDER
 3470ENDPROC
 3480:
 3490DEF PROCPERMUTN   :  REM  includes Combin
 3500 IF RES < 0 OR RES >= 2^31 THEN PRINT ' "COMBIN-PERMUT INPUT IS NEGATIVE"'"OR  EXCEEDS INTEGER RANGE"'" MAX 2^31-1 >= 2E9." :  ENDPROC :   ELSE  N% = RES
 3510IF A$ = "C" THEN  INPUT "n C r "; R$ " COMBINATION  "
 3520  IF A$ = "P" THEN  INPUT "n P r ";R$ " PERMUTATION  "
 3530  R% = EVAL(R$)
 3540  PRINT "N% = ";N%  "   R% = "; R%
 3550  IF R% < 0 OR R% > N% THEN PRINT" R% < 0  OR R% > N%, RES ZERO." : RES = 0 :  ENDPROC
 3560  RES = 1
 3570IF R% < 1 OR R% > N% THEN ENDPROC
 3580IF NOT ( R% = N% AND A$ = "C" )  THEN
 3590   REPEAT
 3600        RES = RES * (N%-R%+1)
 3610        IF A$ = "C" THEN RES = RES / R%
 3620        R% = R% -1
 3630        UNTIL R% = 0
 3640   ENDIF
 3650  ENDPROC
 3660:
 3670DEF PROCOMBIN      :  REM,  MADE A CONDITION IN DEFPROCPERMUTN
 3680INPUT "n C r ";R%
 3690REM  GOTO 269
 3700ENDPROC
 3710:
 3720DEF PROCHCF
 3730INPUT "H.C.F." ' "(Highest Common Factor) "; N$
 3740  N% = EVAL( N$)  :  PRINT  "N% = "; N%
 3750IF RES < 0 THEN RES = ABS( RES)  :  PRINT "MAKE RES > 0,  = "; RES
 3760IF N% <= 0 THEN  N% = ABS( N%)   : PRINT "MAKE N% > 0,  = "; N%
 3770WHILE N% > 0
 3780   X% = RES MOD N%
 3790   RES = N%
 3800   N% = X%
 3810   ENDWHILE
 3820ENDPROC
 3830:
 3840DEF PROCVGENT                  : REM SUPERSEDED BY PROCTDFRAC93
 3850PRINT"CONTINUED FRACTION"
 3860RES = RES - INT RES
 3870IF RES = 0 THEN
 3880        PRINT"TERMINATES"
 3890        ELSE
 3900   RES = 1 / RES
 3910        ENDIF
 3920ENDPROC
 3930:
 3940DEF PROCFODPR
 3950VDU 14
 3960PRINT' CHR$(131)  "Z. FIND NEXT PRIME"
 3970D% = ABS RES
 3980IF D% < 25 THEN
 3990   VDU 15
 4000     PRINT CHR$(7)' "PRIMES LESS THAN 25 ARE:"'" (1 ?), 2, 3, 5, 7, 11, 13, 17, 19 ,23" ' "  I.E. POSITIVE INTEGERS WITH NO OTHER"'" F.ACTORS EXCEPT THEMSELVES AND UNITY"'' "(SEE ALSO   F.ACTORS, D.IVISORS,"'"    Z.PRIMES)"'FNCONT
 4010   PRINT '"TIPS FOR NEXT ODD PRIME." '' "INTERMEDIATE NOS UNTIL NEXT PRIME"'" ARE RESOLVED INTO 2 FACTORS, "'"EITHER, A POWER OF 2 PLUS ODD"'"OR PRODUCT OF TWO ODDS."''"  IN THE LATTER CASE PROGRAM"'" MAY REPORT (SOMETIMES BOTH ODD PRIME)." 'FNCONT
 4020   PRINT' CHR$(7)"WHEN A PRIME IS FOUND THE "'"INCREASE IS CALCULATED, AND"'" IF INCREASE IS < 5, THEN "'"PROG REPORTS SMALL INCREASE."'" (E.G. TWIN PRIMES ARE P AND P+2 "'"  BOTH PRIME)" 'FNCONT
 4030   PRINT'" (PRIME TRIPLES ARE 3 PRIMES: P, P+6,"'" AND NORMALLY ONE OF P+2 OR P+4)"
 4040PRINT'"PROGRAM FINALLY TESTS IF"'" P AND (P-1)/2 ARE BOTH PRIME."'"A CUNNINGHAM PRIME CHAIN IS"'"A SEQUENCE OF PRIMES RELATED"'"BY P AND 2P+1 BOTH PRIME," '" Sophie Germain Primes. ETC." ' FNCONT
 4050PRINT' "SOME SPECIAL INTERESTING PRIMES ARE"'" MERSENNE PRIMES, Mp = 2^p -1" '' "WHERE Prime p = (2 3 5 7 13 17 19 31"'" 61 89 107 127 521 607 1279 2203"'" 2281 3217 4253 4423 9689 9941"'" 11213 19937 21701 23209 44497 86243"
 4060PRINT"110503  132049  216091 , 756839, 859433,"'" 1257787, 1398269  2976221" '"3021377  6972593  13466917  20996011."
 4070  PRINT  " see David WELLS, PENGUIN DICTY OF"'" CURIOUS & INTERESTING NUMBERS, 1987.  "'"AT VARIOUS TIMES THE WORLD'S"'" LARGEST KNOWN PRIME HAS BEEN"'" OFTEN AMERSENNE PRIME."
 4080PRINT FNCONT ' "OTHER SPECIAL PRIMES ARE"'" FERMAT PRIMES,  F(N) = 2^(2^N)+1,"'"WHICH ARE KNOWN TO BE PRIME FOR"'" N = (0,1,2,3,4) ; BUT COMPOSITE "'"(FACTORABLE, NOT PRIME) MOSTLY"'" THEREAFTER."'
 4090PRINT'CHR$(7)"PRIME ACCELERATOR."  FNCONT  '' "HOLD DOWN <SHIFT> Z."
 4100PRINT"PROGRAM CONTINUES CALCULATING"'" PRIMES AND WAITS FOR "'"<ENTER> KEY ONLY IF SMALL INCREASE"'" OR CUNNINGHAM CHAIN FOUND"'" (Sophie Germain Prime)."'' FNCONT
 4110
 4120 : RES = 25 : ENDPROC
 4130  ENDIF
 4140T30% = 2^30
 4150REPEAT
 4160 D%= D%+ 1
 4170 T%=1
 4180 REPEAT
 4190 T% = 2 * T%
 4200 UNTIL D% MOD T% <> 0 OR T% = T30%
 4210 IF T% > 2 THEN
 4220        PRINT; "(" D% " = "TAB(20); T% DIV 2  " * " (2*D%)/T%  : REM GOTO 307
 4230   ELSE Q% = SQR D%
 4240F%=1
 4250REPEAT F% = F% + 2
 4260UNTIL D% MOD F% = 0 OR F% > Q%
 4270IF F% <= Q% THEN
 4280         PRINT"( ";D%" = "F%" * "D% / F%;
 4290         IF F%^3 > D% THEN PRINT " both prime )": ELSE PRINT " )"
 4300        REM   GOTO 307
 4310         ENDIF
 4320   ENDIF
 4330  UNTIL T%=2  AND  F% > Q%
 4340  INCR = D% - RES
 4350RES = D%   :
 4360     IF INCR < 5 THEN PRINT  "SMALL ";
 4370     PRINT "INCREASE = "; INCR  " ,  PRIME = ";  RES
 4380:
 4390REM  TEST   (PRIME-1)  / 2, FOR  CUNNINGHAM PRIMES P, 2P+1
 4400REM SEE COLLINS REFCE DICTY OF MATHEMATICS, EULER PHI (TOTIENT) FUNCTION.
 4410D% = D% DIV 2
 4420PRINT "(P-1) / 2  = " ; D% "= ";
 4430Q% = SQR D%
 4440F% = D% MOD 2
 4450REPEAT  F% = F% + 2
 4460UNTIL D% MOD F% = 0  OR  F% > Q%
 4470IF F% <= Q%  THEN
 4480        PRINT ; F% " X " D% / F%
 4490        ELSE  PRINT CHR$7 "CUNNINGHAM"'" (Sophie Germain PRIME) CHAIN,"' " P WITH 2P+1., ";D% "  AND  "; RES
 4500                ENDIF
 4510
 4520IF F% > Q%  OR INCR < 5 THEN
 4530                PRINT CHR$(7)
 4540          INPUT "Press ENTER CONTINU ";Z$
 4550          ENDIF
 4560PRINT "PRIME = ";
 4570ENDPROC
 4580:
 4590DEF PROCUT
 4600 PRINT"_, DELETE UNITS"
 4610REM  RES = (RES / 10)
 4620IF ABS RES < 2^31  THEN RES = RES DIV 10  ELSE PRINT"REAL" : RES = RES/10
 4630ENDPROC
 4640:
 4650DEF PROCRECALL
 4660PRINT CHR$(7) ' "RECALL RES () ENTER SUBSCRIPT 0-999,"'"OR  (ENTER)  LIST ";
 4670INPUT ; R$
 4680IF R$ = "" THEN R% = 0 ELSE R% = VAL(R$)
 4690IF R% < 0 THEN R% = (RECALL + 1000 + R%) MOD 1000
 4700
 4710IF R% = 0 THEN
 4720   FOR R% = -24 TO 0
 4730   RR = (RECALL + 1000 + R%) MOD 1000
 4740   PRINT "("; RR ")= " RES(RR) " ";
 4750   IF RR MOD 2 = 0 THEN PRINT
 4760   NEXT R%
 4770   R% = RECALL -1
 4780
 4790   ENDIF
 4800RES = RES(R%)
 4810ENDPROC
 4820:
 4830DEF PROCHEX
 4840PRINT"DISPLAY HEX ~ "; ~RES
 4850  PRINT' "DISPLAY BASE 27, A=1, Z=26, 4.1.2003"
 4860  X=RES  : AA$="" : BB$=""
 4870  WHILE X>0
 4880  X1=X MOD 27
 4890  AA$= CHR$(X1 +64)+AA$  :BB$=STR$(X1)+ "," + BB$
 4900  X= X DIV 27
 4910  ENDWHILE
 4920  PRINT "= " AA$   "  =  "BB$ " (BASE 27.)"
 4930  
 4940ENDPROC
 4950:
 4960DEF PROCORDER  :        REM C. 30.5.93
 4970PRINT CHR$(7) ''' "CALCULATE ORDER RESIDUE GROUP" ' "  MOD ";RES
 4980P% = RES
 4990PRINT"ITERATE X= ( A ^ N) MOD P , "
 5000REM ' "( N.B. PSEUDO-RANDOM LIKE LOTTO NOS. ,)"'
 5010PRINT"  UNTIL REPEATS  (FAILS IF DUPLICATES"'" OR CYCLE >= 1000. )"
 5020REM  PRINT"RECOMM P= (CUNNINGHAM / Sophie Germain) PRIME,OPTION ""Z"""
 5030PRINT ' "ENTER GENERATOR ""A"" = SM POSITIVE" ' " INTEGER , MAX="; (2^31 -1) DIV P% ' "Default DECIMAL RECIPR PERIOD (10)."
 5040INPUT; A$
 5050  IF A$ = "" THEN A% = 10   ELSE A% = ABS( EVAL( A$ ) )
 5060PRINT ;P% " MOD  "A% " = "  P% MOD A%
 5070H%() = (0)   : H% = 1000
 5080N% = 0 :  X% = 1
 5090PRINT"PRINT N, X = A^N < ";H%
 5100RSLT% = FALSE
 5110REPEAT
 5120REPEAT N% +=1
 5130   X% = (X% * A%) MOD P%
 5140   UNTIL X% <= H%
 5150VDU 7  :  REM   SOUND 1, -11, X%, 10
 5160
 5170IF  X% < 100  THEN PRINT "^";  N%"= "X% " , ";
 5180IF H%(X%) THEN RSLT%=TRUE    ELSE H%(X%) = N%
 5190REM  PRINT;N%"= "X%" //";
 5200UNTIL RSLT%
 5210RES = N% - H%(X%)
 5220PRINT' CHR$(7) CHR$(7) "ORDER = ";
 5230ENDPROC
 5240
 5250REM  PROG  DEFPROCTDFRAC93
 5260PRINT CHR$(131)  "BAS V/64 PROGM CTDFRAC93, 6.6.93, 1850-"
 5270PRINT"CALCULATE CONTINUED FRACTIONS APPROXIMATION TO DECIMAL REAL NOS. OR RATIONAL FRACTIONS,  ORIGINALLY TIMED AT 15 AUG 1987, PRINTOUT FOR BEEBLET MAGAZINE."
 5280PRINT ' "TO PROVIDE AS FUNCTION OPTION IN PGM SERIcalc4, SERIOUS / SERIAL - CALCULATOR."
 5290PRINT"PROCEDURE WILL OPERATE ON CURRENT VALUE OF RES, RESULT, BY PRESSING KEY W.  WILL ASK FOR A SECOND NO. E.G. DENOMINATOR OF FRACTION OR UNITY, DECIMAL REAL."
 5300PRINT"SHD BE SUITABLE FOR REDUCING FRACTIONS OR EXPRESSING A REAL AS A FRACTION IN LOWEST TERMS."
 5310REM -----------
 5320
 5330DEF PROCTDFRAC93                   :  REM  6.6.93
 5340 REM  VDU 14
 5350B = RES
 5360PRINT CHR$(131) "CTD FRACTION," ' " RATIO TO  DENOM 'A' (default 1)"
 5370INPUT " (ENTER NO. OR EXPRESSION) ";A$
 5380IF A$ = "" THEN A = 1 ELSE A = EVAL(A$)
 5390PRINT A$ " = "; A
 5400
 5410IF A < 0 OR B < 0 THEN  PRINT"MAKE ( BOTH ) POSITIVE"
 5420B = ABS B
 5430A = ABS A
 5440REM  PRINT"TEST IF (EITHER) IS ZERO."
 5450IF A * B <= 0 THEN PRINT "A OR B IS NON-POSITIVE." : ENDPROC
 5460REM  PRINT"MAKE A <= B, SWAP IF NECESSARY."
 5470  ALTB=TRUE
 5480IF A > B THEN ALTB=FALSE : SWAP A, B  : PRINT"( NEEDED TO SWAP SO THAT 0<  A <= B )"
 5490PRINT " CALCULATE B / A ="; B " / "A ' " = "; B / A "  recipr = "  A / B
 5500A0% = 0 : B0% = 1
 5510A1% = 1 :  B1% = 0
 5520PRINT"CTD-FRAC | NUMERATOR / DENOMIN |=DECIMAL" ' "fraction"
 5530 ax=0
 5530REPEAT
 5540C% = B / A
 5550A2 = A0% + C% * A1%
 5560IF A2 >= 2^31  THEN
 5570         PRINT "LIMIT , BIG ENOUGH"
 5580         A = 0
 5590          ELSE A2% = A2
 5600B2% = B0% + C% * B1%
 5610 ax+=1
 5610IF (  C% > 4 )  AND  ( B1% > 1 ) OR ax >7  THEN PRINT "PREV. LINE IS(very) Economical APPROXN." ' FNCONT ' :ax = 0
 5620PRINT ; C% " " ;
 5630  IF ALTB THEN PRINT ;A2%  "/" B2%  "= " ;STR$( A2% / B2%)  ELSE PRINT;B2%  "/" A2%  "= " STR$( B2% / A2%)
 5640IF C% = 0 THEN
 5650         PRINT "UNEXPECTED CONDITION, C%=0" : A = 0
 5660         ELSE
 5670X = B - C% * A
 5680A0% = A1% : A1% = A2%
 5690B0% = B1% : B1% = B2%
 5700B = A
 5710A = X
 5720        ENDIF
 5730        ENDIF
 5740UNTIL A = 0
 5750REM,  IS IT WANTED TO CHANGE VALUE RES TO FINAL DENOMIN?  : RES = B2%
 5760VDU 15
 5770ENDPROC
 5780
 5790DEF PROCHELP    :  REM  KEYWORDS  6.6.93 , 24.6.93
 5800PRINT 'CHR$(131) "?  HELP ?"
 5810
 5820PRINT "OPTIONS, HELPS ETC," FNCONT
 5830PRINT'"N.EW,    <ESC> INSTRUCTIONS," ' "Q.UIT,  ? HELP,  O. OPTIONS"
 5840PRINT "' (APOSTR') REMARKS ANNOTATIONS,"'"<SPACE> ADD-ON BASIC OPERATOR"
 5850PRINT"COMMA, <ENTER> PUNCTUATE NUMERIC RESULTS"
 5860  PRINT"@,  CHECK / RESET PRINT FORMAT"
 5870PRINT "B. PRINTER (B ON, C OFF, * SPOOL)"  ' "() [] RECALL RES."'
 5880
 5890PRINT  "?  HELP ?"'
 5900
 5910PRINT ' "REAL FNS,"; FNCONT '
 5920PRINT '"+  -  *  /  ^,  1234.. APPEND DIGITS"
 5930PRINT "E. ADD EXPONENT (10),  L. LOGARITHM."
 5940PRINT  "R. RECIPROCAL,  S. CHANGE SIGN +/-,"'"T. ANTILOG (10^X), V. SQR ROOT"
 5950PRINT "X. EXP, e^X, Y. Roots & Powers,"'"% PERCENT, J multiples."
 5960
 5970PRINT ' "SERIcalc4 CAP LETTER FNS-"'" THAT MAY INVOLVE (PART) "'" INTEGER ARITHMETIC" FNCONT
 5980  PRINT' "A. ORDER,   C. COMBIN ,  D = DIVISOR,"
 5990  PRINT "F.  FACTOR, G. FRACTIONAL PART,"'"H. HCF,  I. INTEGER PART"
 6000PRINT "K.  EXPRESS AS SUM OF (2) SQUARES"
 6010  PRINT "M. DIV-MOD,   P.PERMUTATION,"
 6020  PRINT "U. POISSON DISTRIBN, W. CONTIND FRACTION"'"Z. NEXT PRIME, ! FACTORIAL"
 6030  PRINT "& HEX INPUT,  ~ DISPLAY HEX,"'"UNDER_SCORE DELETE UNITS"
 6040
 6050
 6060PRINT ' "SOME BASIC FUNCTION KEYWORDS." ' FNCONT
 6070PRINT"EXP   LOG   LN"'"SIN   COS   TAN"'"INT   DIV   MOD"'"DEG   RAD   PI"
 6080PRINT"ASN   ACS   ATN"'"ABS   RND   SGN"'"SQR   TIME "'"ASC   LEN"
 6090
 6100ENDPROC
 6110REM  -------------------------
 6120REM   >  DONMCD.BBC-MODELB.DON93/5.POISS
 6130PRINT CHR$(131)  "BASIC 64 PROGM POISS,  7.6.93,  1935-2010"
 6140PRINT' "POISSON DISTRIBUTION PROBABILITIES TO MERGE WITH SERIcalc4, BY DON S MCDONALD, WGTN 0-4- 389-6820."
 6150RES = TIME      : PRINT "RES (TIME)  =  ";RES
 6160REPEAT
 6170PRINT'" OPTION U. POISSON DISTRBN FREQS"
 6180INPUT "ENTER START VALUE, Q. END", A$
 6190IF A$ <> "" THEN RES = EVAL(A$)
 6200IF A$ <> "Q" THEN PROCPOISSON
 6210UNTIL A$ = "Q" OR A$ = "q"
 6220PRINT ' "PROGM POISS e n d."
 6230END
 6240REM   ----------------------
 6250
 6260DEF PROCPOISSON       : REM  7.6.93
 6270U = RES
 6280REM  VDU 14
 6290PRINT'' " POISSON DISTRIBUTION PARAMETER, MU," 'CHR$(7) "  (  Best needs Basic64 )"'" U = MEAN = VARIANCE = "; U
 6300IF U <= 0 THEN PRINT "REQUIRES POSITIVE U, TRY AGAIN" : ENDPROC
 6310IF U > 80 AND U < 700 THEN PRINT '"WARNING" ''" YOU HAVE ENTERED POISSON PARAMETER"'"  BETWEEN 80 < U < 700"'" FOR LARGE NUMBERS ARITHMETIC"'" SPEED AND ACCURACY YOU SHOULD"'" LOAD BASIC64 (CLICK ON SCICALC)." ' "THEN RE- RUN ""SERICALC"" (OR ""SERIcalc4"".)"'
 6320INPUT "O.K. ?  CONTINU "; A$
 6330PRINT "STANDARD DEVIATION = ";  SQR(U)
 6340P0 = EXP(-U)
 6350
 6360PRINT' " P(0) =  "; P0
 6370  PRINT  "P(INT MU) = (APPROX) ";
 6380PU = 1/ SQR(2* PI* U)
 6390  IF U > 1 THEN PRINT ; PU   ELSE PRINT' "* P( MU <=1) ALSO "; P0
 6400INPUT "ENTER X MIN > 0 START <RETURN> "; X0%
 6410IF X0% < 1 THEN X0% = 1
 6420F = 1 :  P = 1  :  S = P0
 6430PRINT ' "X  (LN P ) |  P  | CUMULATIVE =1|"
 6440  PRINT "INTERRUPT, <ESCAPE.> "
 6450  X% = 0
 6460  REPEAT  X% += 1
 6470IF U < 700 THEN
 6480   F = F * U/X%
 6490   P = P0 * F
 6500   S += P
 6510   ELSE PLN = (X% - U) + X%*LN( U / X%) -( LN(2*PI* X%)/2 +1/(12*X%) -1/(360*X%^3) +1/(1260*X%^5) ) :  REM EMPIRICAL STIRLING FORMULA LN X!.
 6520   P = EXP(PLN)
 6530   S += P
 6540   ENDIF
 6550IF X% >= X0% THEN
 6560IF U < 700 THEN PRINT; X%" "P " "  S  : ELSE PRINT;  X% " "PLN " " P "  " S
 6570IF X% MOD 10 = 0 THEN PRINT  "X (LN P ) |  P | S=CUMULATIVE =1|" ' "CONTINU  SPC,   OR   ELSE <ESCAPE.> "; FNCONT
 6580   ENDIF
 6590UNTIL  S >= 1 OR (S > .5 AND S+P = S)
 6600REM PRINT "VIRTUALLY INFINITE LOOP, INTERRUPT WITH <ESCAPE>."
 6610  PRINT "CUMUL. PROB. = "; S " >= 1." ' "or plateau, AT X% = "; X%
 6620INPUT "CONTINU ";A$
 6630ENDPROC
 6640
 6650DEF PROCDIVISORS  :  REM  8.6.93
 6660REM  VDU 14
 6670R% =  ABS RES +.5   : PRINT "ROUND TO NEAREST (+ve) INTEGER"
 6680PRINT CHR$(131) "DIVISORS OF INTEGER, R% = "; R%
 6690DD% = 0 : REM COUNT
 6700DSUM = 0  :  REM  SUM DIVISORS
 6710FOR X% = 1 TO SQR( R% )
 6720IF R% MOD X% = 0 THEN
 6730        PRINT;X%  " * " R% DIV X% ; : DD% +=2
 6740        DSUM += X% + R% DIV X%
 6750        PRINT TAB(14) "DSUM= "; DSUM   " DD%= "DD%
 6760        :  IF DD% MOD 24 = 10 THEN PRINT "DSUM/R% = ";DSUM / R% " " FNCONT
 6770        IF (X%^2 = R%)  THEN
 6780                DSUM -= X%      :  DD% -= 1
 6790                PRINT "PERFECT SQUARE,  DSUM (SUM OF DIVISORS )= "; DSUM
 6800                ENDIF
 6810        ENDIF
 6820NEXT X%
 6830MULTIPERFECT = DSUM / R%   :  REM SERIcalc4, 1/5/94,  18/6/94.
 6840PRINT "NO. OF DIVISORS , DD% = "; DD%
 6850PRINT"  DSUM / number R% = "; MULTIPERFECT
 6860IF MULTIPERFECT < 2 THEN PRINT "DEFICIENT."
 6870IF MULTIPERFECT = 2 THEN PRINT "PERFECT."
 6880IF MULTIPERFECT > 2 THEN PRINT "ABUNDANT."
 6890IF MULTIPERFECT = INT(MULTIPERFECT)  THEN PRINT "MULTIPERFECT INDEX = ";MULTIPERFECT
 6900
 6910ENDPROC
 6920END
 6930
 6940REM   >   DISPCOMMAS
 6950PRINT "BBC BASIC VI PGM DISPCOMMAS, 21.6.93, 22.6, 2250-2340"
 6960PRINT' "DISPLAY NUMBERS IN COMMA FORMAT, BY D S MCDONALD, WGTN, 0-4- 389-6820"
 6970A$ = "0"
 6980REPEAT
 6990RES = EVAL(A$)
 7000PROCOMMA
 7010PRINT; "= " RES "   ";
 7020INPUT B$
 7030A$ = STR$(RES) + B$
 7040UNTIL FALSE
 7050END
 7060
 7070DEF PROCOMMA
 7080X$ = STR$(RES)
 7090PRINT"DISPLAY COMMA'S (,000)" ; TAB(10);
 7100IF LEN(X$) < 5 THEN
 7110        PRINT; X$
 7120
 7130        ELSE
 7140        PRINT;  LEFT$(X$,1);
 7150        X$ = MID$( X$,2)
 7160        E = INSTR( X$, "E")
 7170        P = INSTR( X$, ".")
 7180
 7190        IF E > 0 THEN
 7200                PRINT; LEFT$( X$, P);
 7210                D$ = MID$( X$, P+1, E-P-1)
 7220
 7230                WHILE LEN(D$) > 3
 7240                        PRINT; LEFT$(D$, 3) ",";
 7250                        D$ = MID$( D$, 4)
 7260                        ENDWHILE
 7270
 7280                PRINT; D$; MID$( X$, E)
 7290
 7300                ELSE
 7310                REM  P. "FIXED POINT FORMAT "; X$
 7320
 7330                IF P = 0 THEN
 7340                        REM  P. "INTEGER"
 7350                        X = ((LEN( X$)-1) MOD 3) + 1   : REM ???
 7360                        PRINT; LEFT$( X$, X) ;
 7370                        REPEAT
 7380                                PRINT; "," MID$( X$, X+1, 3) ;
 7390                                X = X + 3
 7400                                UNTIL X = LEN( X$ )
 7410                        ELSE
 7420                        REM PRINT "MIXED NUMBER / UP TO DEC PT"
 7430                             D$ = LEFT$( X$, P-1)
 7440                             IF LEN(D$) < 4 THEN
 7450                                     PRINT; D$ ;
 7460                                     ELSE
 7470                                     REM COMMA'S REQ'D B4 DECIMAL POINT
 7480                                     X =  LEN(D$) MOD 3
 7490                                     PRINT; LEFT$( D$, X);
 7500                                     REPEAT
 7510                                             PRINT; "," MID$( D$, X+1, 3) ;
 7520                                             X = X + 3
 7530                                             UNTIL X = LEN( D$ )
 7540                                     REM  P.; MID$( X$, P)
 7550                                     ENDIF
 7560
 7570                             REM PASSED DECIMAL POINT
 7580                             D$ = MID$( X$, P)
 7590                             PRINT LEFT$( D$,4) ; : REM DECIMAL PT
 7600                             X = 4
 7610
 7620                             WHILE LEN( D$) > X
 7630                                     PRINT "," MID$( D$, X+1,3);
 7640                                     X = X+3
 7650                                     ENDWHILE
 7660
 7670                        ENDIF
 7680                             PRINT
 7690                ENDIF
 7700ENDIF
 7710ENDPROC
 7720 REM ===================
 7730DEF FNCONT
 7740PRINT CHR$(7) CHR$(131) "CONTINU ";
 7750CONT$  = GET$
 7760= CONT$
 7770REM =================
 7780REM  >  $.DONMCD.CALC.SUMSQS
 7790PRINT "PGM SUMSQUARES  (SUMSQS), 5/9/93, 1725-"'
 7800PRINT" RESOLVE INTEGER INTO SUM OF 2 SQUARES, BY DS MCDONALD" ' "WGTN 0-4- 389-6820"
 7810ON ERROR REPORT
 7820INPUT '"ENTER START,  0 END";RES
 7830IF RES = 0 THEN PRINT "PGM SUMSQS  E N D."; : END
 7840PROCSUMSQS
 7850END
 7860
 7870DEF PROCSUMSQS
 7880PRINT''" SUM OF (2) SQUARES,"'" X% = A%^2 + B%^2 ( UNTIL ESCAPE)"CHR$(7)
 7890 PRINT '"RETURN <CR>. OR ENTER 2 SIDES  S1,S2,"'"(default <CR> THE PROG WILL"'" USE  'RES' = ";RES" FOR SQUARE.)"
 7900 INPUT LINE; S1$ :
 7910 IF S1$ = "" THEN
 7902X% = ABS RES - 1
 7904 ELSE
 7914 S3 = INSTR(S1$,",")
 7924 IF S3>0 THEN S2= EVAL(MID$(S1$,S3+1)) :S1$= LEFT$(S1$,S3-1) ELSE S2=0
 7934 S1= EVAL(S1$)
 7944 X%= S1^2+S2^2 -1
 7954 PRINT" X%= S1^2+S2^2 -1...=" ;S1"^2 +"S2"^2."
 7910 ENDIF
 7920 
 7930 
 7900REPEAT
 7910     X% += 1
 7920     PRINT ; X%
 7930     A% = 0 : A1% = SQR( X% / 2)
 7940 ax=0
 7940     REPEAT
 7950        B = SQR( X% - A% ^ 2)
 7960        IF B = INT B THEN
 7970  REM PRINT ; "  = "A%"^2 ("A%^2") + "B"^2 ("B^2 ")"
 7980  PRINT ; "=("A%"/"B")^2 =("A%^2"/"B^2"):"A%/B :  RES = X% :
 7990  ax+=1 :IF ax MOD 8=  6 THEN PRINT "LINE ax= (";ax" ) cont.";GET$
 8000  ENDIF
 7970        A% += 1  :
 7980        UNTIL  A% > A1%
 7990 G$ = "continu."
 7990        IF  RES = X% THEN PROCRSLT(X%)  : PRINT' CHR$(7)  "CONTINU. MORE squares,"'" OR  Kk.Nn.EXT PROCESS,  Q-q.uit":  G$ = GET$
 8000     UNTIL INSTR("KkNnQq",G$)
 8010 PRINT "next process."
 8010ENDPROC
 8020
 8030DEF PROCmultiples
 8040PRINT "OPTION J. nx multiples"'"DISP. MULTIPLES AND SUBMULTIPLES OF X."'
 8050FOR mult = 1 TO 500
 8060IF mult MOD 15=5 THEN PRINT "nx multiples "; RES"/submult<ESC>"GET$
 8070
 8080PRINT ;mult"*x= "RES*mult;TAB(19)"x/n= "RES/mult
 8090NEXT mult
 8100ENDPROC
