# 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