Another update from ingydotnet^djgoku

Task/Digital-root/ALGOL-W/digital-root.alg

@@ -0,0 +1,63 @@
+begin
+
+    % calculates the digital root and persistence of an integer in base 10   %
+    % in order to allow for numbers larger than 2^31, the number is passed   %
+    % as the lower and upper digits e.g. 393900588225 can be processed by    %
+    % specifying upper = 393900, lower = 58825                               %
+    procedure findDigitalRoot( integer value  upper, lower
+                             ; integer result digitalRoot, persistence
+                             ) ;
+    begin
+
+        integer procedure sumDigits( integer value n ) ;
+        begin
+            integer digits, sum;
+
+            digits := abs n;
+            sum    := 0;
+
+            while digits > 0
+            do begin
+                sum    := sum + ( digits rem 10 );
+                digits := digits div 10
+            end % while digits > 0 % ;
+
+            % result: % sum
+        end sumDigits;
+
+        digitalRoot := sumDigits( upper ) + sumDigits( lower );
+        persistence := 1;
+
+        while digitalRoot > 9
+        do begin
+            persistence := persistence + 1;
+            digitalRoot := sumDigits( digitalRoot );
+        end % while digitalRoot > 9 % ;
+
+    end findDigitalRoot ;
+
+    % calculates and prints the digital root and persistence                 %
+    procedure printDigitalRootAndPersistence( integer value upper, lower ) ;
+    begin
+        integer digitalRoot, persistence;
+        findDigitalRoot( upper, lower, digitalRoot, persistence );
+        write( s_w := 0  % set field saeparator width for this statement %
+             , i_w := 8  % set integer field width for this statement    %
+             , upper
+             , ", "
+             , lower
+             , i_w := 2  % change integer field width %
+             , ": digital root: "
+             , digitalRoot
+             , ", persistence: "
+             , persistence
+             )
+    end printDigitalRootAndPersistence ;
+
+    % test the digital root and persistence procedures %
+    printDigitalRootAndPersistence(      0, 627615 );
+    printDigitalRootAndPersistence(      0,  39390 );
+    printDigitalRootAndPersistence(      0, 588225 );
+    printDigitalRootAndPersistence( 393900, 588225 )
+
+end.

Task/Digital-root/Batch-File/digital-root.bat

@@ -0,0 +1,44 @@
+::
+::Digital Root Task from Rosetta Code Wiki
+::Batch File Implementation
+::
+::Base 10...
+::
+
+@echo off
+setlocal enabledelayedexpansion
+
+::THE MAIN THING...
+for %%x in (9876543214 393900588225 1985989328582 34559) do (
+	call :droot %%x
+)
+echo.
+pause
+exit /b
+::/THE MAIN THING...
+
+::THE FUNCTION
+:droot
+set inp2sum=%1&set persist=1
+
+:cyc1
+set sum=0
+set scan_digit=0
+:cyc2
+set digit=!inp2sum:~%scan_digit%,1!
+if "%digit%"=="" (goto :sumdone)
+set /a sum+=%digit%
+set /a scan_digit+=1
+goto :cyc2
+
+:sumdone
+if %sum% lss 10 (
+	echo.
+	echo ^(%1^)
+	echo Additive Persistence=%persist% Digital Root=%sum%.
+	goto :EOF
+)
+set /a persist+=1
+set inp2sum=%sum%
+goto :cyc1
+::/THE FUNCTION

Task/Digital-root/Befunge/digital-root.bf

@@ -0,0 +1,8 @@
+0" :rebmun retnE">:#,_0 0v
+v\1:/+55p00<v\`\0::-"0"<~<
+#>:55+%00g+^>9`+#v_+\ 1+\^
+>|`9:p000<_v#`1\$<  v"gi"<
+|> \ 1 + \ >0" :toor lat"^
+>$$00g\1+^@,+<v"Di",>#+ 5<
+>:#,_$ . 5 5 ^>:#,_\.55+,v
+^"Additive Persistence: "<

Task/Digital-root/C++/digital-root.cpp

@@ -4,29 +4,27 @@
 //
 #include <iostream>
 #include <cmath>
-#include <tuple>
+#include <utility>
 
-std::tuple<const unsigned long long int,int,int> DigitalRoot(const unsigned long long int digits, const int BASE = 10) {
-    int x = SumDigits(digits,BASE);
-    int ap = 1;
-    while (x >= BASE) {
-        x = SumDigits(x,BASE);
-        ap++;
-    }
-    return std::make_tuple(digits,ap,x);
+template<class P_> P_ IncFirst(const P_& src) {return P_(src.first + 1, src.second);}
+
+std::pair<int, int> DigitalRoot(unsigned long long digits, int base = 10)
+{
+    int x = SumDigits(digits, base);
+    return x < base ? std::make_pair(1, x) : IncFirst(DigitalRoot(x, base));  // x is implicitly converted to unsigned long long; this is lossless
 }
 
 int main() {
-    const unsigned long long int ip[] = {961038,923594037444,670033,448944221089};
+    const unsigned long long ip[] = {961038,923594037444,670033,448944221089};
     for (auto i:ip){
         auto res = DigitalRoot(i);
-        std::cout << std::get<0>(res) << " has digital root " << std::get<2>(res) << " and additive persistance " << std::get<1>(res) << "\n";
+        std::cout << i << " has digital root " << res.second << " and additive persistance " << res.first << "\n";
     }
     std::cout << "\n";
-    const unsigned long long int hip[] = {0x7e0,0x14e344,0xd60141,0x12343210};
+    const unsigned long long hip[] = {0x7e0,0x14e344,0xd60141,0x12343210};
     for (auto i:hip){
         auto res = DigitalRoot(i,16);
-        std::cout << std::hex << std::get<0>(res) << " has digital root " << std::get<2>(res) << " and additive persistance " << std::get<1>(res) << "\n";
+        std::cout << std::hex << i << " has digital root " << res.second << " and additive persistance " << res.first << "\n";
     }
     return 0;
 }

Task/Digital-root/DCL/digital-root.dcl

@@ -0,0 +1,18 @@
+$ x = p1
+$ count = 0
+$ sum = x
+$ loop1:
+$  length = f$length( x )
+$  if length .eq. 1 then $ goto done
+$  i = 0
+$  sum = 0
+$  loop2:
+$   digit = f$extract( i, 1, x )
+$   sum = sum + digit
+$   i = i + 1
+$   if i .lt. length then $ goto loop2
+$  x = f$string( sum )
+$  count = count + 1
+$  goto loop1
+$ done:
+$ write sys$output p1, " has additive persistence ", count, " and digital root of ", sum

Task/Digital-root/Elixir/digital-root.elixir

@@ -0,0 +1,25 @@
+defmodule Digital do
+  def root(n, base \\ 10), do: root(n, base, 0)
+
+  def root(n, base, ap) when n < base, do: {n, ap}
+  def root(n, base, ap) do
+    Integer.to_string(n, base)
+    |> String.codepoints
+    |> Enum.reduce(0, fn x,acc -> acc + String.to_integer(x, base) end)
+    |> root(base, ap+1)
+  end
+end
+
+data = [627615, 39390, 588225, 393900588225]
+Enum.each(data, fn n ->
+  {dr, ap} = Digital.root(n)
+  IO.puts "#{n} has additive persistence #{ap} and digital root of #{dr}"
+end)
+
+base = 16
+IO.puts "\nBase = #{base}"
+fmt = "~.#{base}B(#{base}) has additive persistence ~w and digital root of ~w~n"
+Enum.each(data, fn n ->
+  {dr, ap} = Digital.root(n, base)
+  :io.format fmt, [n, ap, dr]
+end)

Task/Digital-root/J/digital-root-6.j

@@ -0,0 +1,4 @@
+   10 digrt 627615
+9
+   10 addpr 627615
+2

Task/Digital-root/Julia/digital-root.julia

@@ -0,0 +1,15 @@
+function digitalroot{S<:Integer,T<:Integer}(n::S, bs::T=10)
+    -1 < n && 1 < bs || throw(DomainError())
+    ds = n
+    pers = 0
+    while bs <= ds
+        ds = sum(digits(ds, bs))
+        pers += 1
+    end
+    return (pers, ds)
+end
+
+for i in {627615, 39390, 588225, 393900588225, big(2)^100}
+    (pers, ds) = digitalroot(i)
+    println(i, " has persistence ", pers, " and digital root ", ds)
+end

Task/Digital-root/Python/digital-root.py

@@ -1,10 +1,13 @@
-def droot (n):
-    x = [n]
-    while x[-1] > 10:
-        x.append(sum(int(dig) for dig in str(x[-1])))
-    return len(x) - 1, x[-1]
+def digital_root (n):
+    ap = 0
+    n = abs(int(n))
+    while n >= 10:
+        n = sum(int(digit) for digit in str(n))
+        ap += 1
+    return ap, n
 
-for n in [627615, 39390, 588225, 393900588225]:
-    a, d = droot (n)
-    print "%12i has additive persistance %2i and digital root of %i" % (
-        n, a, d)
+if __name__ == '__main__':
+    for n in [627615, 39390, 588225, 393900588225, 55]:
+        persistance, root = digital_root(n)
+        print("%12i has additive persistance %2i and digital root %i."
+              % (n, persistance, root))

Task/Digital-root/VBScript/digital-root.vb

@@ -0,0 +1,15 @@
+Function digital_root(n)
+	ap = 0
+	Do Until Len(n) = 1
+		x = 0
+		For i = 1 To Len(n)
+			x = x + CInt(Mid(n,i,1))
+		Next
+		n = x
+		ap = ap + 1
+	Loop
+	digital_root = "Additive Persistence = " & ap & vbCrLf &_
+		"Digital Root = " & n & vbCrLf	
+End Function
+
+WScript.StdOut.Write digital_root(WScript.Arguments(0))