March 2014 update

Task/Digital-root/Applesoft-BASIC/digital-root.applesoft

@@ -0,0 +1,87 @@
+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,

Task/Digital-root/AutoHotkey/digital-root.ahk

@@ -0,0 +1,18 @@
+p := {}
+for key, val in [30,1597,381947,92524902,448944221089]
+{
+    n := val
+    while n > 9
+    {
+        m := 0
+        Loop, Parse, n
+            m += A_LoopField
+        n := m, i := A_Index
+    }
+    p[A_Index] := [val, n, i]
+}
+
+for key, val in p
+    Output .= val[1] ": Digital Root = " val[2] ", Additive Persistence = " val[3] "`n"
+
+MsgBox, 524288, , % Output

Task/Digital-root/Common-Lisp/digital-root.lisp

@@ -0,0 +1,11 @@
+(defun digital-root (number &optional (base 10))
+  (loop for n = number then s
+        for ap = 1 then (1+ ap)
+        for s = (sum-digits n base)
+        when (< s base)
+          return (values s ap)))
+
+(loop for (nr base) in '((627615 10) (393900588225 10) (#X14e344 16) (#36Rdg9r 36))
+      do (multiple-value-bind (dr ap) (digital-root nr base)
+           (format T "~vR (base ~a): additive persistence = ~a, digital root = ~vR~%"
+                   base nr base ap base dr)))

Task/Digital-root/Pascal/digital-root.pascal

@@ -0,0 +1,70 @@
+program DigitalRoot;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  SysUtils, StrUtils;
+
+// FPC has no Big mumbers implementation, Int64 will suffice.
+
+procedure GetDigitalRoot(Value: Int64; Base: Byte; var DRoot, Pers: Integer);
+var
+  i: Integer;
+  DigitSum: Int64;
+begin
+  Pers := 0;
+  repeat
+    Inc(Pers);
+    DigitSum := 0;
+    while Value > 0 do
+    begin
+      Inc(DigitSum, Value mod Base);
+      Value := Value div Base;
+    end;
+    Value := DigitSum;
+  until Value < Base;
+  DRoot := Value;
+End;
+
+function IntToStrBase(Value: Int64; Base: Byte):String;
+const
+  // usable up to 36-Base
+  DigitSymbols = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXY';
+begin
+  Result := '';
+  while Value > 0 do
+  begin
+    Result := DigitSymbols[Value mod Base+1] + Result;
+    Value := Value div Base;
+  End;
+
+End;
+
+procedure Display(const Value: Int64; Base: Byte = 10);
+var
+  DRoot, Pers: Integer;
+  StrValue: string;
+begin
+  GetDigitalRoot(Value, Base, DRoot, Pers);
+  WriteLn(Format('%s(%d) has additive persistence %d and digital root %d.',
+    [IntToStrBase(Value, Base), Base, Pers, DRoot]));
+End;
+
+begin
+  WriteLn('--- Examples in 10-Base ---');
+  Display(627615);
+  Display(39390);
+  Display(588225);
+  Display(393900588225);
+
+  WriteLn('--- Examples in 16-Base ---');
+  Display(627615, 16);
+  Display(39390, 16);
+  Display(588225, 16);
+  Display(393900588225, 16);
+
+  ReadLn;
+End.

Task/Digital-root/PowerShell/digital-root.psh

@@ -0,0 +1,19 @@
+function Get-DigitalRoot ($n)
+{
+    function Get-Digitalsum ($n)
+    {
+        if ($n -lt 10) {$n}
+        else {
+            ($n % 10) + (Get-DigitalSum ([math]::Floor($n / 10)))
+        }
+    }
+
+    $ap = 0
+    do {$n = Get-DigitalSum $n; $ap++}
+    until ($n -lt 10)
+    $DigitalRoot = [pscustomobject]@{
+        'Sum' = $n
+        'Additive Persistence' = $ap
+    }
+    $DigitalRoot
+}