# Perfect Numbers Example 2 - Listing

10 REM Generation of perfect numbers using the 2x2x2x2x2xp assumption.PGM. NA ME:GPERFN3 15 DIM A%(255),B%(255),C%(255) 17 MODE7 20 q%=1:rt%=1 30 REPEAT 40 q%=2*q% 50 rt%=rt%+q% 60 PROCtest(rt%) 70 IF prime THEN PRINT;q%;" x ";rt%;" is perfect.":A\$=STR\$(q%):B\$=STR\$(rt%):P ROCfermat:PRINT"= ";C\$;' 80 UNTIL rt%>999999999 90 END 2000 DEFPROCtest(A%) 2005 D%=2:prime=TRUE 2010 IF A%/D%=INT(A%/D%) THEN prime=FAL SE:ENDPROC 2020 D%=3 2025 IF A%=3 THEN prime=TRUE:ENDPROC 2030 IF A%/D%=INT(A%/D%) THEN prime=FAL SE:ENDPROC 2040 REPEAT 2050 D%=D%+2 2060 IF A%/D%=INT(A%/D%) THEN prime=FAL SE 2070 UNTIL D%>SQR(A%) 2080 ENDPROC 29999 REM``````````````````````````````` ```````````````````````````````````` 30000 DEFPROCfermat 30010 PROCinitial 30030 PROCmult 30060 PROCreorderc 30070 IF N% VDU7 30080 ENDPROC 30100 DEFPROCinitial 30110 N%=0:LA=LENA\$:LB=LENB\$ 30120 IF LA>LB L%=LA ELSE L%=LB 30130 FOR I%=0 TO L% 30140 A%(I%)=-(I%<LA)*VALMID\$(A\$,LA-I%,1 ) 30150 B%(I%)=-(I%<LB)*VALMID\$(B\$,LB-I%,1 ) 30160 NEXT 30170 ENDPROC 30270 DEFPROCmult 30280 U%=2*L% 30290 PROCzeroc 30300 FOR I%=0 TO L%-1 30310 FOR J%=0 TO L%-1 30320 K%=I%+J% 30330 C%(K%)=A%(J%)*B%(I%)+C%(K%) 30340 NEXT J%,I% 30350 ENDPROC 31050 DEFPROCzeroc 31060 FOR I%=0 TO U% 31070 C%(I%)=0 31080 NEXT 31090 ENDPROC 31110 DEFPROCreorderc 31120 C%=0:CSIG=0:C\$="" 31130 FOR I%=0 TO U% 31140 K%=C%(I%)+C% 31150 C%(I%)=K% MOD 10:C%=K% DIV 10 31160 IF C%(I%) CSIG=I% 31170 C\$=CHR\$(48+C%(I%))+C\$ 31180 NEXT 31190 C\$=RIGHT\$(C\$,CSIG+1) 31200 ENDPROC