8-Bit Software Online Conversion

Palindromic Numbers. Reprise - Listing

5MODE7:PRINT"SWITCH PRINTER ON" 10 REM Finding palindromic numbers wh ose squares and cubes are palindromic. P ETER DAVY Nov. 1994. Pgm. Name:LAPPY2 15 DIM A%(255),B%(255),C%(255) 20 FOR D%=2 TO 9:REM Range of no. of digits in the numbers to be squared and cubed. To change range, change 2 and 9. 30 IF D%/2=INT(D%/2) THEN even%=TRUE ELSE even%=FALSE 40 IF even% THEN b%=10^((D%/2)-1) ELS E b%=10^((D%-1)/2-1) 50 IF even% THEN PROCeven ELSE PROCod d 60 NEXT D% 70 END 4999 REM``````````````````````````````` ````````````````````````````````````` 5000 DEFPROCodd 5010 b%=b%-1:m%=-1 5020 REPEAT 5030 b%=b%+1 5040 REPEAT 5050 m%=m%+1 5060 A$=STR$(b%)+STR$(m%)+FNrev(b%):B$= A$ 5070 PROCfermat 5080 PROCtest(C$) 5090 IF pal THEN VDU2:PRINT A$;" ";C$: VDU3 ELSE PRINT A$ 5092 A$=C$ 5094 PROCfermat 5096 PROCtest(C$) 5098 IF pal THEN VDU2:PRINT B$;" ";C$; " CUBE":VDU3 ELSE PRINT B$ 5100 UNTIL m%=9 5110 m%=-1 5120 UNTIL STR$(b%)=STRING$(LEN(STR$(b% )),"9") 5130 ENDPROC 6999 REM``````````````````````````````` ````````````````````````````````````` 7000 DEFPROCeven 7010 b%=b%-1 7020 REPEAT 7030 b%=b%+1 7040 A$=STR$(b%)+FNrev(b%):B$=A$ 7050 PROCfermat 7060 PROCtest(C$) 7070 IF pal THEN VDU2:PRINT A$;" ";C$: VDU3 ELSE PRINT A$ 7072 A$=C$ 7074 PROCfermat 7076 PROCtest(C$) 7078 IF pal THEN VDU2:PRINT B$;" ";C$; " CUBE":VDU3 ELSE PRINT B$ 7080 UNTIL STR$(b%)=STRING$(LEN(STR$(b% )),"9") 7090 ENDPROC 7999 REM``````````````````````````````` ````````````````````````````````````` 8000 DEFFNrev(X%) 8010 X$=STR$(X%) 8020 R$="" 8030 FOR F%=LEN(X$) TO 1 STEP-1 8040 R$=R$+MID$(X$,F%,1) 8050 NEXT F% 8060 =R$ 8999 REM``````````````````````````````` ````````````````````````````````````` 9000 DEFPROCtest(Q$) 9010 pl%=0:pr%=LEN(Q$)+1 9020 REPEAT 9030 pl%=pl%+1:pr%=pr%-1 9040 l$=MID$(Q$,pl%,1):r$=MID$(Q$,pr%,1 ) 9050 UNTIL l$<>r$ OR pr%-pl%<3 9060 IF l$=r$ AND pr%-pl%<3 THEN pal=TR UE ELSE pal=FALSE 9070 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