Data update

Task/Digital-root/Ada/digital-root-1.adb

@@ -0,0 +1,15 @@
+package Generic_Root is
+   type Number is range 0 .. 2**63-1;
+   type Number_Array is array(Positive range <>) of Number;
+   type Base_Type is range 2 .. 16; -- any reasonable base to write down numb
+
+   generic
+      with function "&"(X, Y: Number) return Number;
+      -- instantiate with "+" for additive digital roots
+      -- instantiate with "*" for multiplicative digital roots
+   procedure Compute_Root(N: Number;
+                     Root, Persistence: out Number;
+                     Base: Base_Type := 10);
+   -- computes Root and Persistence of N;
+
+end Generic_Root;

Task/Digital-root/Ada/digital-root-2.adb

@@ -0,0 +1,26 @@
+package body Generic_Root is
+
+   procedure Compute_Root(N: Number;
+                     Root, Persistence: out Number;
+                     Base: Base_Type := 10) is
+
+      function Digit_Sum(N: Number) return Number is
+      begin
+         if N < Number(Base) then
+            return N;
+         else
+            return (N mod Number(Base)) & Digit_Sum(N / Number(Base));
+         end if;
+      end Digit_Sum;
+
+   begin
+      if N < Number(Base) then
+         Root := N;
+         Persistence := 0;
+      else
+         Compute_Root(Digit_Sum(N), Root, Persistence, Base);
+         Persistence := Persistence + 1;
+      end if;
+   end Compute_Root;
+
+end Generic_Root;

Task/Digital-root/Ada/digital-root-3.adb

@@ -0,0 +1,26 @@
+with Generic_Root, Ada.Text_IO; use Generic_Root;
+
+procedure Digital_Root is
+
+   procedure Compute is new Compute_Root("+");
+     -- "+" for additive digital roots
+
+   package TIO renames Ada.Text_IO;
+
+    procedure Print_Roots(Inputs: Number_Array; Base: Base_Type) is
+      package NIO is new TIO.Integer_IO(Number);
+      Root, Pers: Number;
+   begin
+      for I in Inputs'Range loop
+         Compute(Inputs(I), Root, Pers, Base);
+         NIO.Put(Inputs(I), Base => Integer(Base), Width => 12);
+         NIO.Put(Root, Base => Integer(Base), Width => 9);
+         NIO.Put(Pers, Base => Integer(Base), Width => 12);
+         TIO.Put_Line("   " & Base_Type'Image(Base));
+      end loop;
+   end Print_Roots;
+begin
+   TIO.Put_Line("      Number     Root Persistence  Base");
+   Print_Roots((961038, 923594037444, 670033, 448944221089), Base => 10);
+   Print_Roots((16#7e0#, 16#14e344#, 16#12343210#), Base => 16);
+end Digital_Root;

Task/Digital-root/COBOL/digital-root.cob

@@ -0,0 +1,45 @@
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. DIGITAL-ROOT.
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01 VARIABLES.
+          03 INPUT-NUMBER     PIC 9(16).
+          03 INPUT-DIGITS     REDEFINES INPUT-NUMBER,
+                              PIC 9 OCCURS 16 TIMES.
+          03 DIGIT-SUM        PIC 999.
+          03 DIGIT-NO         PIC 99.
+          03 PERSISTENCE      PIC 9.
+
+       01 OUTPUT-FORMAT.
+          03 O-NUMBER         PIC Z(15)9.
+          03 FILLER           PIC X(16) VALUE ': PERSISTENCE = '.
+          03 O-PERSISTENCE    PIC Z9.
+          03 FILLER           PIC X(9) VALUE ', ROOT = '.
+          03 O-ROOT           PIC Z9.
+
+       PROCEDURE DIVISION.
+       BEGIN.
+           MOVE 627615 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
+           MOVE 39390 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
+           MOVE 588225 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
+           MOVE 393900588225 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
+           STOP RUN.
+
+       FIND-DIGITAL-ROOT.
+           MOVE ZERO TO PERSISTENCE.
+           MOVE INPUT-NUMBER TO O-NUMBER.
+           PERFORM SUMMATION UNTIL INPUT-NUMBER IS LESS THAN 10.
+           MOVE INPUT-NUMBER TO O-ROOT.
+           MOVE PERSISTENCE TO O-PERSISTENCE.
+           DISPLAY OUTPUT-FORMAT.
+
+       SUMMATION.
+           MOVE ZERO TO DIGIT-SUM.
+           ADD 1 TO PERSISTENCE.
+           PERFORM ADD-DIGIT VARYING DIGIT-NO FROM 1 BY 1
+               UNTIL DIGIT-NO IS GREATER THAN 16.
+           MOVE DIGIT-SUM TO INPUT-NUMBER.
+
+       ADD-DIGIT.
+           ADD INPUT-DIGITS(DIGIT-NO) TO DIGIT-SUM.

Task/Digital-root/Gleam/digital-root.gleam

@@ -0,0 +1,49 @@
+import gleam/int
+import gleam/io
+import gleam/list
+
+pub fn sum_digits(n: Int) -> Int {
+  sum_digits_base(n, 10)
+}
+
+pub fn sum_digits_base(n: Int, base: Int) -> Int {
+  sum_digits_helper(n, base, 0)
+}
+
+fn sum_digits_helper(n: Int, base: Int, acc: Int) -> Int {
+  case n, base, acc {
+    0, _, acc -> acc
+    n, base, acc if n < base -> acc + n
+    n, base, acc -> sum_digits_helper(n / base, base, acc + { n % base })
+  }
+}
+
+pub fn persistance_root(x: Int) -> #(Int, Int) {
+  persistance_root_helper(sum_digits(x), 1)
+}
+
+fn persistance_root_helper(x: Int, n: Int) -> #(Int, Int) {
+  case x, n {
+    x, n if x < 10 -> #(n, x)
+    x, n -> persistance_root_helper(sum_digits(x), n + 1)
+  }
+}
+
+pub fn task() {
+  let ns = [627_615, 39_390, 588_225, 393_900_588_225]
+  let res = list.map(ns, fn(x) { #(x, persistance_root(x)) })
+  list.each(res, fn(pair) {
+    let #(x, #(y, z)) = pair
+    io.println(
+      x |> int.to_string
+      <> " has additive persitence "
+      <> y |> int.to_string
+      <> " and digital root of "
+      <> z |> int.to_string,
+    )
+  })
+}
+
+pub fn main() {
+  task()
+}

Task/Digital-root/Pluto/digital-root.pluto

@@ -0,0 +1,10 @@
+local int = require "int"
+local fmt = require "fmt"
+
+local a = {1, 14, 267, 8128, 627615, 39390, 588225, 393900588225}
+for a as n do
+    local res = int.digroot(n)
+    local dr = res[1]
+    local ap = res[2]
+    fmt.print("%15s has additive persistence %d and digital root of %d", fmt.int(n), ap, dr)
+end

Task/Digital-root/PowerShell/digital-root-1.ps1

@@ -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
+}

Task/Digital-root/PowerShell/digital-root-2.ps1

@@ -0,0 +1,9 @@
+function Get-DigitalRoot {
+    param($n)
+    $ap = 0
+    do {$n = Invoke-Expression ("0"+([string]$n -split "" -join "+")+"0"); $ap++} while ($n -ge 10)
+    [PSCustomObject]@{
+        DigitalRoot = $n
+        AdditivePersistence = $ap
+    }
+}

Task/Digital-root/Rebol/digital-root.rebol

@@ -0,0 +1,33 @@
+Rebol [
+    title: "Rosetta code: Digital root"
+    file:  %Digital_root.r3
+    url:   https://rosettacode.org/wiki/Digital_root
+    needs: 3.0.0
+]
+droot: function [
+    "Calculate the digital root and additive persistence of a number"
+    num   [integer!]
+    return: [block!] "[persistence root]"
+] [
+    persistence: 0
+    ;; Keep summing digits until we get a single digit
+    until [
+        ;; Convert number to string for digit processing
+        str: form num
+        num: 0
+        ;; Iterate through each character in the string
+        ;; Convert each digit character to its numeric value and sum
+        forall str [ num: num + (str/1 - #"0") ]
+        ;; Count how many iterations we've done
+        ++ persistence
+        ;; Stop when we reach a single digit (< 10)
+        num < 10
+    ]
+    ;; Return both the persistence count and the final digital root
+    reduce [persistence num]
+]
+;; Test the function with several numbers
+foreach i [627615 39390 588225 393900588225 55] [
+    a: droot i
+    print [pad i -12 "has additive persistence" a/1 "and digital root of" a/2]
+]

Task/Digital-root/Uiua/digital-root.uiua

@@ -0,0 +1,3 @@
+[627615 39390 588225 393900588225]
+Root ← ⍢(/+⊥₁₀⊙+₁|>10)⊙0
+≡(&p$"_:  \tdigital root = _, additive persistence = _"⟜Root)

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

@@ -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))