RosettaCodeData/Task/Digital-root/Applesoft-BASIC/digital-root.basic

88 lines
1.6 KiB
Plaintext

1 GOSUB 430"BASE SETUP
2 FOR E = 0 TO 1 STEP 0
3 GOSUB 7"READ
4 ON E + 1 GOSUB 50, 10
5 NEXT E
6 END
7 READ N$
8 E = N$ = ""
9 RETURN
10 GOSUB 7"READ BASE
20 IF E THEN RETURN
30 BASE = VAL(N$)
40 READ N$
50 GOSUB 100"DIGITAL ROOT
60 GOSUB 420: PRINT " HAS AD";
70 PRINT "DITIVE PERSISTENCE";
80 PRINT " "P" AND DIGITAL R";
90 PRINT "OOT "X$";" : RETURN
REM DIGITAL ROOT OF N$, RETURNS X$ AND P
100 P = 0 : L = LEN(N$)
110 X$ = MID$(N$, 2, L - 1)
120 N = LEFT$(X$, 1) = "-"
130 IF NOT N THEN X$ = N$
140 FOR P = 0 TO 1E38
150 L = LEN(X$)
160 IF L < 2 THEN RETURN
170 GOSUB 200"DIGIT SUM
180 X$ = S$
190 NEXT P : STOP
REM DIGIT SUM OF X$, RETURNS S$
200 S$ = "0"
210 R$ = X$
220 L = LEN(R$)
230 FOR L = L TO 1 STEP -1
240 E$ = "" : V$ = RIGHT$(R$, 1)
250 GOSUB 400 : S = LEN(S$)
260 ON R$ <> "0" GOSUB 300
270 R$ = MID$(R$, 1, L - 1)
280 NEXT L
290 RETURN
REM ADD V TO S$
300 FOR C = V TO 0 STEP 0
310 V$ = RIGHT$(S$, 1)
320 GOSUB 400 : S = S - 1
330 S$ = MID$(S$, 1, S)
340 V = V + C : C = V >= BASE
350 IF C THEN V = V - BASE
360 GOSUB 410 : E$ = V$ + E$
370 IF S THEN NEXT C
380 IF C THEN S$ = "1"
390 S$ = S$ + E$ : RETURN
REM BASE VAL
400 V = V(ASC(V$)) : RETURN
REM BASE STR$
410 V$ = V$(V) : RETURN
REM BASE DISPLAY
420 PRINT N$;
421 IF BASE = 10 THEN RETURN
422 PRINT "("BASE")";
423 RETURN
REM BASE SETUP
430 IF BASE = 0 THEN BASE = 10
440 DIM V(127), V$(35)
450 FOR I = 0 TO 35
460 V = 55 + I - (I < 10) * 7
470 V$(I) = CHR$(V)
480 V(V) = I
490 NEXT I : RETURN
500 DATA627615,39390,588225
510 DATA393900588225
1000 DATA,30
1010 DATADIGITALROOT
63999DATA,