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