Rosetta Code

Digital root: Difference between revisions

Page Discussion

Digital root (view source)

Revision as of 16:26, 2 March 2024

11,551 bytes added ,  2 months ago
no edit summary
No edit summary
 
(19 intermediate revisions by 15 users not shown)
Line 27:
=={{header|11l}}==
{{trans|Python}}
<langsyntaxhighlight lang="11l">F digital_root(=n)
V ap = 0
L n >= 10
Line 37:
Int64 persistance, root
(persistance, root) = digital_root(n)
print(‘#12 has additive persistance #2 and digital root #..’.format(n, persistance, root))</langsyntaxhighlight>
{{out}}
<pre>
Line 48:
 
=={{header|360 Assembly}}==
<langsyntaxhighlight lang="360asm">* Digital root 21/04/2017
DIGROOT CSECT
USING DIGROOT,R13 base register
Line 93:
XDEC DS CL12
YREGS
END DIGROOT</langsyntaxhighlight>
{{out}}
<pre>
Line 105:
We first specify a Package "Generic_Root" with a generic procedure "Compute". The package is reduced for the implementation of multiplicative digital roots [[http://rosettacode.org/wiki/Digital_root/Multiplicative_digital_root#Ada]]. Further note the tunable parameter for the number base (default 10).
 
<langsyntaxhighlight Adalang="ada">package Generic_Root is
type Number is range 0 .. 2**63-1;
type Number_Array is array(Positive range <>) of Number;
Line 119:
-- computes Root and Persistence of N;
end Generic_Root;</langsyntaxhighlight>
 
The implementation is straightforward: If the input N is a digit, then the root is N and the persistence is zero. Else, commute the digit-sum DS. The root of N is the root of DS, the persistence of N is 1 + (the persistence of DS).
 
<langsyntaxhighlight Adalang="ada">package body Generic_Root is
procedure Compute_Root(N: Number;
Line 148:
end Compute_Root;
end Generic_Root;</langsyntaxhighlight>
 
Finally the main program. The procedure "Print_Roots" is for our convenience.
 
<langsyntaxhighlight Adalang="ada">with Generic_Root, Ada.Text_IO; use Generic_Root;
 
procedure Digital_Root is
Line 177:
Print_Roots((961038, 923594037444, 670033, 448944221089), Base => 10);
Print_Roots((16#7e0#, 16#14e344#, 16#12343210#), Base => 16);
end Digital_Root;</langsyntaxhighlight>
 
{{out}}
Line 191:
 
=={{header|ALGOL 68}}==
<langsyntaxhighlight lang="algol68"># calculates the digital root and persistance of n #
PROC digital root = ( LONG LONG INT n, REF INT root, persistance )VOID:
BEGIN
Line 224:
; print digital root and persistance( 588225 )
; print digital root and persistance( 393900588225 )
END</langsyntaxhighlight>
{{out}}
<pre>
Line 234:
 
=={{header|ALGOL W}}==
<langsyntaxhighlight lang="algolw">begin
 
% calculates the digital root and persistence of an integer in base 10 %
Line 296:
printDigitalRootAndPersistence( 393900, 588225 )
 
end.</langsyntaxhighlight>
{{out}}
<pre>
Line 306:
 
=={{header|AppleScript}}==
<langsyntaxhighlight lang="applescript">on digitalroot(N as integer)
script math
to sum(L)
Line 327:
 
 
digitalroot(627615)</langsyntaxhighlight>
 
{{out}}<pre>{N:627615, persistences:2, root:9}</pre>
Line 334:
Or, generalizing to allow for other bases, composing a solution from generic primitives, and testing a few more numbers.
 
<langsyntaxhighlight lang="applescript">-------------------------- TESTS --------------------------
on run
set firstCol to justifyRight(18, space)
Line 667:
set my text item delimiters to dlm
s
end unlines</langsyntaxhighlight>
{{Out}}
<pre>Base 10:
Line 677:
 
=={{header|Applesoft BASIC}}==
<langsyntaxhighlight ApplesoftBasiclang="applesoftbasic">1 GOSUB 430"BASE SETUP
2 FOR E = 0 TO 1 STEP 0
3 GOSUB 7"READ
Line 763:
1000 DATA,30
1010 DATADIGITALROOT
63999DATA,</langsyntaxhighlight>
{{out}}
<pre>627615 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 9;
Line 775:
{{trans|Ruby}}
 
<langsyntaxhighlight lang="rebol">droot: function [num][
persistence: 0
until [
Line 787:
a: droot i
print [i "has additive persistence" a\0 "and digital root of" a\1]
]</langsyntaxhighlight>
 
{{out}}
Line 797:
 
=={{header|AutoHotkey}}==
<langsyntaxhighlight AutoHotkeylang="autohotkey">p := {}
for key, val in [30,1597,381947,92524902,448944221089]
{
Line 814:
Output .= val[1] ": Digital Root = " val[2] ", Additive Persistence = " val[3] "`n"
MsgBox, 524288, , % Output</langsyntaxhighlight>
{{out}}
<pre> 30: Digital Root = 3, Additive Persistence = 1
Line 823:
 
=={{header|AWK}}==
<langsyntaxhighlight AWKlang="awk"># syntax: GAWK -f DIGITAL_ROOT.AWK
BEGIN {
n = split("627615,39390,588225,393900588225,10,199",arr,",")
Line 847:
}
return(s)
}</langsyntaxhighlight>
{{out}}
<pre>
Line 862:
{{improve}}
This calculates the result "the hard way", but is limited to the limits of a 32-bit signed integer (+/-2,147,483,647) and therefore can't calculate the digital root of 393,900,588,225.
<langsyntaxhighlight lang="qbasic">DECLARE SUB digitalRoot (what AS LONG)
 
'test inputs:
Line 885:
END IF
PRINT what; ": additive persistance "; c; ", digital root "; w
END SUB</langsyntaxhighlight>
{{out}}
627615 : additive persistance 2 , digital root 9
Line 893:
==={{header|ASIC}}===
Compile with the ''Extended math'' option.
<langsyntaxhighlight lang="basic">
REM Digital root
DATA 1&, 14&, 267&, 8128&, 39390&, 588225&, 627615&
Line 922:
Root = N&
RETURN
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 933:
627615 2 9
</pre>
 
==={{header|BASIC256}}===
<syntaxhighlight lang="vb">global dr
global ap
 
dim a = {627615, 39390, 588225}
 
for i = 0 to a[?]-1
dr = digitalRoot(a[i])
print a[i], "Additive Persistence = "; ap, "Digital root = "; dr
next i
end
 
function digitalRoot(n)
ap = 0
do
dr = 0
while n > 0
dr += n mod 10
n = n \ 10
end while
ap += 1
n = dr
until dr < 10
return dr
end function</syntaxhighlight>
{{out}}
<pre>627615 Additive Persistence = 2 Digital root = 9
39390 Additive Persistence = 2 Digital root = 6
588225 Additive Persistence = 2 Digital root = 3</pre>
 
==={{header|Nascom BASIC}}===
{{trans|ASIC}}
{{works with|Nascom ROM BASIC|4.7}}
<langsyntaxhighlight lang="basic">
10 REM Digital root
20 FOR I=0 TO 6
Line 959 ⟶ 989:
590 ROOT=N
600 RETURN
</syntaxhighlight>
</lang>
{{out}}
<pre> 1 0 1
1 0 1
14 1 5
267 2 6
Line 968 ⟶ 997:
39390 2 6
588225 2 3
627615 2 9</pre>
 
</pre>
==={{header|True BASIC}}===
<syntaxhighlight lang="qbasic">SUB digitalroot (what)
LET dr = ABS(what)
IF dr > 10 THEN
LET ap = 0
DO
LET ap = ap + 1
DO WHILE dr <> 0
LET t = t + REMAINDER(dr, 10)
LET dr = IP(dr / 10)
LOOP
LET dr = t
LET t = 0
LOOP WHILE dr > 9
END IF
PRINT what, "Additive persistance ="; ap, "Digital root ="; dr
END SUB
 
CALL digitalroot (627615)
CALL digitalroot (39390)
CALL digitalroot (588225)
CALL digitalroot (393900588225)
END</syntaxhighlight>
{{out}}
<pre>
627615 Additive persistence = 2 Digital root = 9
39390 Additive persistence = 2 Digital root = 6
588225 Additive persistence = 2 Digital root = 3
393900588225 Additive persistence = 2 Digital root = 9</pre>
 
==={{header|Yabasic}}===
<syntaxhighlight lang="vb">dim a(2)
a(0) = 627615 : a(1) = 39390 : a(2) = 588225
for i = 0 to arraysize(a(),1)
dr = digitalRoot(a(i))
print a(i), "\tAdditive persistence = ", ap, "\tDigital root = ", dr
next i
end
 
sub digitalRoot(n)
ap = 0
repeat
dr = 0
while n > 0
dr = dr + mod(n, 10)
n = int(n / 10)
wend
ap = ap + 1
n = dr
until dr < 10
return dr
end sub</syntaxhighlight>
{{out}}
<pre>627615 Additive persistence = 2 Digital root = 9
39390 Additive persistence = 2 Digital root = 6
588225 Additive persistence = 2 Digital root = 3</pre>
 
=={{header|Batch File}}==
<langsyntaxhighlight lang="dos">:: Digital Root Task from Rosetta Code Wiki
:: Batch File Implementation
:: (Base 10)
Line 1,011 ⟶ 1,096:
set inp2sum=%sum%
goto :cyc1
:: /THE FUNCTION</langsyntaxhighlight>
{{out}}
<pre>(9876543214)
Line 1,029 ⟶ 1,114:
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight lang="bbcbasic"> *FLOAT64
PRINT "Digital root of 627615 is "; FNdigitalroot(627615, 10, p) ;
PRINT " (additive persistence " ; p ")"
Line 1,057 ⟶ 1,142:
n = q
ENDWHILE
= s</langsyntaxhighlight>
{{out}}
<pre>
Line 1,070 ⟶ 1,155:
The number, ''n'', is read as a string from stdin in order to support a larger range of values than would typically be accepted by the numeric input of most Befunge implementations. After the initial value has been summed, though, subsequent iterations are simply calculated as integer sums.
 
<langsyntaxhighlight lang="befunge">0" :rebmun retnE">:#,_0 0v
v\1:/+55p00<v\`\0::-"0"<~<
#>:55+%00g+^>9`+#v_+\ 1+\^
Line 1,077 ⟶ 1,162:
>$$00g\1+^@,+<v"Di",>#+ 5<
>:#,_$ . 5 5 ^>:#,_\.55+,v
^"Additive Persistence: "<</langsyntaxhighlight>
 
{{out}} (multiple runs)
Line 1,100 ⟶ 1,185:
Other bases can be used by changing the <code>DSum</code> function, which is derived from a [https://mlochbaum.github.io/bqncrate/ BQNcrate] idiom.
 
<langsyntaxhighlight lang="bqn">DSum ← +´10{⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)}
Root ← 0⊸{(×○⌊÷⟜10)◶⟨𝕨‿𝕩,(1+𝕨)⊸𝕊 Dsum⟩𝕩}
 
Line 1,107 ⟶ 1,192:
P 39390
P 588225
P 393900588225</langsyntaxhighlight>
<syntaxhighlight lang="text">⟨ 627615 2 9 ⟩
⟨ 39390 2 6 ⟩
⟨ 588225 2 3 ⟩
⟨ 393900588225 2 9 ⟩</langsyntaxhighlight>
[https://mlochbaum.github.io/BQN/try.html#code=RFN1bSDihpAgK8K0MTB74oy98J2Vl3zijIriiJjDt+KfnPCdlZfijZ8o4oaVMSvCt+KMivCdlZfii4bigbwx4oyI4oqiKX0KUm9vdCDihpAgMOKKuHsow5fil4vijIrDt+KfnDEwKeKXtuKfqPCdlajigL/wnZWpLCgxK/Cdlagp4oq48J2ViiBEc3Vt4p+p8J2VqX0KClAg4oaQIOKAolNob3cg4oqi4oi+Um9vdApQIDYyNzYxNQpQIDM5MzkwClAgNTg4MjI1ClAgMzkzOTAwNTg4MjI1Cg== Try It!]
 
=={{header|Bracmat}}==
<langsyntaxhighlight lang="bracmat"> ( root
= sum persistence n d
. !arg:(~>9.?)
Line 1,143 ⟶ 1,228:
?
| done
);</langsyntaxhighlight>
{{out}}
<pre>627615 has additive persistence 2 and digital root of 9
Line 1,153 ⟶ 1,238:
 
=={{header|C}}==
<langsyntaxhighlight lang="c">#include <stdio.h>
 
int droot(long long int x, int base, int *pers)
Line 1,178 ⟶ 1,263:
 
return 0;
}</langsyntaxhighlight>
 
=={{header|C sharp|C#}}==
<langsyntaxhighlight lang="csharp">using System;
using System.Linq;
 
Line 1,204 ⟶ 1,289:
}
}
}</langsyntaxhighlight>
{{out}}
<pre>627615 has additive persistence 2 and digital root 9
Line 1,213 ⟶ 1,298:
=={{header|C++}}==
For details of SumDigits see: http://rosettacode.org/wiki/Sum_digits_of_an_integer
<langsyntaxhighlight lang="cpp">// Calculate the Digital Root and Additive Persistance of an Integer - Compiles with gcc4.7
//
// Nigel Galloway. July 23rd., 2012
Line 1,242 ⟶ 1,327:
}
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>961038 has digital root 9 and additive persistance 2
Line 1,256 ⟶ 1,341:
 
=={{header|Clojure}}==
<syntaxhighlight lang="clojure">
<lang Clojure>
(defn dig-root [value]
(let [digits (fn [n]
Line 1,269 ⟶ 1,354:
(recur (sum (digits n))
(inc step))))))
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,280 ⟶ 1,365:
 
=={{header|CLU}}==
<langsyntaxhighlight lang="clu">sum_digits = proc (n, base: int) returns (int)
sum: int := 0
while n > 0 do
Line 1,310 ⟶ 1,395:
|| int$unparse(root))
end
end start_up</langsyntaxhighlight>
{{out}}
<pre>627615 has additive persistence 2 and digital root of 9
Line 1,319 ⟶ 1,404:
=={{header|Common Lisp}}==
Using <code>SUM-DIGITS</code> from the task "[[Sum_digits_of_an_integer#Common_Lisp|Sum digits of an integer]]".
<langsyntaxhighlight lang="lisp">(defun digital-root (number &optional (base 10))
(loop for n = number then s
for ap = 1 then (1+ ap)
Line 1,329 ⟶ 1,414:
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)))</langsyntaxhighlight>
{{Out}}
<pre>627615 (base 10): additive persistence = 2, digital root = 9
Line 1,338 ⟶ 1,423:
=={{header|Component Pascal}}==
{{Works with|BlackBox Component Builder}}
<langsyntaxhighlight lang="oberon2">
MODULE DigitalRoot;
IMPORT StdLog, Strings, TextMappers, DevCommanders;
Line 1,379 ⟶ 1,464:
END Do;
END DigitalRoot.
</syntaxhighlight>
</lang>
Execute:
^Q DigitalRoot.Do 627615 39390 588225 393900588~
Line 1,391 ⟶ 1,476:
 
=={{header|COBOL}}==
<langsyntaxhighlight lang="cobol"> IDENTIFICATION DIVISION.
PROGRAM-ID. DIGITAL-ROOT.
 
Line 1,435 ⟶ 1,520:
 
ADD-DIGIT.
ADD INPUT-DIGITS(DIGIT-NO) TO DIGIT-SUM.</langsyntaxhighlight>
{{out}}
<pre> 627615: PERSISTENCE = 2, ROOT = 9
Line 1,443 ⟶ 1,528:
 
=={{header|Cowgol}}==
<langsyntaxhighlight lang="cowgol">include "cowgol.coh";
 
# Calculate the digital root and additive persistance of a number
Line 1,480 ⟶ 1,565:
test(39390);
test(588225);
test(9992);</langsyntaxhighlight>
 
{{out}}
Line 1,493 ⟶ 1,578:
 
If you just want the digital root, you can use this, which is almost 100x faster than calculating it with persistence:
<langsyntaxhighlight lang="ruby">def digital_root(n : Int, base = 10) : Int
max_single_digit = base - 1
n = n.abs
Line 1,505 ⟶ 1,590:
puts digital_root 39390
puts digital_root 588225
puts digital_root 7, base: 3</langsyntaxhighlight>
 
{{out}}
Line 1,514 ⟶ 1,599:
 
The faster approach when calculating it with persistence uses exponentiation and log to avoid converting to and from strings.
<langsyntaxhighlight lang="ruby">def digital_root_with_persistence(n : Int) : {Int32, Int32}
n = n.abs
persistence = 0
Line 1,531 ⟶ 1,616:
puts digital_root_with_persistence 627615
puts digital_root_with_persistence 39390
puts digital_root_with_persistence 588225</langsyntaxhighlight>
 
{{out}}
Line 1,539 ⟶ 1,624:
 
However, the string-conversion based solution is easiest to read.
<langsyntaxhighlight lang="ruby">def digital_root_with_persistence_to_s(n : Int) : {Int32, Int32}
n = n.abs
persistence = 0
Line 1,556 ⟶ 1,641:
puts digital_root_with_persistence_to_s 627615
puts digital_root_with_persistence_to_s 39390
puts digital_root_with_persistence_to_s 588225</langsyntaxhighlight>
 
{{out}}
Line 1,564 ⟶ 1,649:
 
=={{header|D}}==
<langsyntaxhighlight lang="d">import std.stdio, std.typecons, std.conv, std.bigint, std.math,
std.traits;
 
Line 1,599 ⟶ 1,684:
foreach (immutable b; [2, 3, 8, 10, 16, 36])
writefln(f2, b, n.digitalRoot(b)[]); // Shortened output.
}</langsyntaxhighlight>
{{out}}
<pre>101(2): additive persistance= 2, digital root= 1
Line 1,649 ⟶ 1,734:
Procedure <code>q</code> is for summing all digits left by procedure <code>p</code>.
Procedure <code>r</code> is for overall control (when to stop).
<langsyntaxhighlight Dclang="dc">?[10~rd10<p]sp[+z1<q]sq[lpxlqxd10<r]dsrxp</langsyntaxhighlight>
 
=={{header|DCL}}==
<langsyntaxhighlight DCLlang="dcl">$ x = p1
$ count = 0
$ sum = x
Line 1,669 ⟶ 1,754:
$ goto loop1
$ done:
$ write sys$output p1, " has additive persistence ", count, " and digital root of ", sum</langsyntaxhighlight>
{{out}}
<pre>$ @digital_root 627615
Line 1,680 ⟶ 1,765:
=={{header|Delphi}}==
See [https://rosettacode.org/wiki/Digital_root#Pascal Pascal].
 
=={{header|EasyLang}}==
<syntaxhighlight lang="easylang">
proc digitalRoot n . x persistence .
numberString$ = n
currentPersist = 0
while len numberString$ > 1
for i = 1 to len numberString$
sum += number substr numberString$ i 1
.
numberString$ = sum
currentPersist += 1
sum = 0
.
x = number numberString$
persistence = currentPersist
.
numbers[] = [ 627615 39390 588225 393900588225 ]
for i in numbers[]
digitalRoot i x persistence
print i
print "Additive persistence: " & persistence
print "Digital root: " & x
.
</syntaxhighlight>
{{out}}
<pre>
627615
Additive persistence: 2
Digital root: 9
39390
Additive persistence: 2
Digital root: 6
588225
Additive persistence: 2
Digital root: 3
393900588225
Additive persistence: 2
Digital root: 9
</pre>
 
=={{header|Eiffel}}==
<syntaxhighlight lang="eiffel">
<lang Eiffel>
class
APPLICATION
Line 1,752 ⟶ 1,877:
end
end
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,763 ⟶ 1,888:
=={{header|Elena}}==
{{trans|C#}}
ELENA 56.0x :
<langsyntaxhighlight lang="elena">import extensions;
import system'routines;
import system'collections;
Line 1,777 ⟶ 1,902:
while (num > 9)
{
num := num.toPrintable().toArray().selectBy::(ch => ch.toInt() - 48).summarize(new LongInteger());
additivepersistence += 1
Line 1,788 ⟶ 1,913:
public program()
{
new long[]{627615l, 39390l, 588225l, 393900588225l}.forEach::(num)
{
var t := num.DigitalRoot;
Line 1,794 ⟶ 1,919:
console.printLineFormatted("{0} has additive persistence {1} and digital root {2}", num, t.Item1, t.Item2)
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,805 ⟶ 1,930:
=={{header|Elixir}}==
{{works with|Elixir|1.1}}
<langsyntaxhighlight lang="elixir">defmodule Digital do
def root(n, base\\10), do: root(n, base, 0)
Line 1,826 ⟶ 1,951:
{dr, ap} = Digital.root(n, base)
:io.format fmt, [n, ap, dr]
end)</langsyntaxhighlight>
 
{{out}}
Line 1,844 ⟶ 1,969:
=={{header|Erlang}}==
Using [[Sum_digits_of_an_integer]].
<langsyntaxhighlight Erlanglang="erlang">-module( digital_root ).
 
-export( [task/0] ).
Line 1,858 ⟶ 1,983:
persistance_root( X, N ) when X < 10 -> {N, X};
persistance_root( X, N ) -> persistance_root( sum_digits:sum_digits(X), N + 1 ).
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,870 ⟶ 1,995:
=={{header|F_Sharp|F#}}==
This code uses sumDigits from [[Sum_digits_of_an_integer#or_Generically]]
<langsyntaxhighlight lang="fsharp">
//Find the Digital Root of An Integer - Nigel Galloway: February 1st., 2015
//This code will work with any integer type
Line 1,878 ⟶ 2,003:
if s < BASE then (s,p) else root(p+1, s)
root(LanguagePrimitives.GenericZero<_> + 1, N)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,898 ⟶ 2,023:
 
=={{header|Factor}}==
<langsyntaxhighlight lang="factor">USING: arrays formatting kernel math math.text.utils sequences ;
IN: rosetta-code.digital-root
 
Line 1,910 ⟶ 2,035:
printf ;
{ 627615 39390 588225 393900588225 } [ print-root ] each</langsyntaxhighlight>
{{out}}
<pre>627615 has additive persistence 2 and digital root 9.
Line 1,919 ⟶ 2,044:
=={{header|Forth}}==
This is trivial to do in Forth, because radix control is one of its most prominent feature. The 32-bits version just takes two lines:
<langsyntaxhighlight lang="forth">: (Sdigit) 0 swap begin base @ /mod >r + r> dup 0= until drop ;
: digiroot 0 swap begin (Sdigit) >r 1+ r> dup base @ < until ;</langsyntaxhighlight>
This will take care of most numbers:
<pre>
Line 1,928 ⟶ 2,053:
</pre>
For the last one we will need a "double number" version. '''MU/MOD''' is not available in some Forth implementations, but it is easy to define:
<langsyntaxhighlight lang="forth">[UNDEFINED] mu/mod [IF] : mu/mod >r 0 r@ um/mod r> swap >r um/mod r> ; [THEN]
 
: (Sdigit) 0. 2swap begin base @ mu/mod 2>r s>d d+ 2r> 2dup d0= until 2drop ;
: digiroot 0 -rot begin (Sdigit) 2>r 1+ 2r> 2dup base @ s>d d< until d>s ;</langsyntaxhighlight>
That one will take care of the last one:
<pre>
Line 1,938 ⟶ 2,063:
 
=={{header|Fortran}}==
<syntaxhighlight lang="fortran">
<lang Fortran>
program prec
implicit none
Line 1,970 ⟶ 2,095:
write(*,*) 'additive persistance = ', a
end subroutine
</syntaxhighlight>
</lang>
 
<pre>
Line 1,988 ⟶ 2,113:
 
=={{header|FreeBASIC}}==
<langsyntaxhighlight lang="freebasic">' FB 1.05.0 Win64
 
Function digitalRoot(n As UInteger, ByRef ap As Integer, base_ As Integer = 10) As Integer
Line 2,014 ⟶ 2,139:
Next
Print "Press any key to quit"
Sleep</langsyntaxhighlight>
 
{{out}}
Line 2,029 ⟶ 2,154:
=={{header|Fōrmulæ}}==
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Digital_root}}
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation &mdash;i.e. XML, JSON&mdash; they are intended for storage and transfer purposes more than visualization and edition.
 
'''Solution'''
Programs in Fōrmulæ are created/edited online in its [https://formulae.org website], However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.
 
[[File:Fōrmulæ - Digital root 01.png]]
In '''[https://formulae.org/?example=Digital_root this]''' page you can see the program(s) related to this task and their results.
 
'''Test cases'''
 
[[File:Fōrmulæ - Digital root 02.png]]
 
[[File:Fōrmulæ - Digital root 03.png]]
 
=={{header|Go}}==
With function <code>Sum</code> from [[Sum digits of an integer#Go]].
 
<langsyntaxhighlight lang="go">package main
 
import (
Line 2,105 ⟶ 2,236:
}
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 2,127 ⟶ 2,258:
=={{header|Groovy}}==
{{trans|Java}}
<langsyntaxhighlight lang="groovy">class DigitalRoot {
static int[] calcDigitalRoot(String number, int base) {
BigInteger bi = new BigInteger(number, base)
Line 2,152 ⟶ 2,283:
}
}
}</langsyntaxhighlight>
{{out}}
<pre>627615 has additive persistence 2 and digital root of 9
Line 2,160 ⟶ 2,291:
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">import Data.Bifunctor (bimap)
import Data.List (unfoldr)
import Data.Tuple (swap)
Line 2,178 ⟶ 2,309:
main = do
putStrLn "in base 10:"
mapM_ (print . ((,) <*> digRoot 10)) [627615, 39390, 588225, 393900588225]</langsyntaxhighlight>
{{out}}
<pre>
Line 2,188 ⟶ 2,319:
</pre>
 
<langsyntaxhighlight lang="haskell">import Data.Tuple (swap)
import Data.Maybe (fromJust)
import Data.List (elemIndex, unfoldr)
Line 2,250 ⟶ 2,381:
, (36, "50YE8N29")
, (36, "37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN")
]</langsyntaxhighlight>
{{out}}
<pre>
Line 2,262 ⟶ 2,393:
 
=={{header|Huginn}}==
<langsyntaxhighlight lang="huginn">main( argv_ ) {
if ( size( argv_ ) < 2 ) {
throw Exception( "usage: digital-root {NUM}" );
Line 2,277 ⟶ 2,408:
print( "{}\n".format( acc ) );
return ( 0 );
}</langsyntaxhighlight>
 
=={{header|Icon}} and {{header|Unicon}}==
The following works in both languages:
<langsyntaxhighlight lang="unicon">procedure main(A)
every m := n := integer(!A) do {
ap := 0
Line 2,293 ⟶ 2,424:
n ? while s +:= move(1)
return s
end</langsyntaxhighlight>
{{out|Sample run}}
<pre>
Line 2,305 ⟶ 2,436:
 
=={{header|J}}==
<syntaxhighlight lang="j">digrt=: 10&$: :(|&.<:^:<:)"0
 
<lang J>digrotaddps=: 10&$: :([: <:@# +/@(#.inv~&10)^:_a:)"0</syntaxhighlight>
With these functions, the base can be supplied as a left argument (dyadic). When being called monadically, they default to base 10.
addper=: _1 + [: # +/@(#.inv~&10)^:a:</lang>
 
Example use:
<syntaxhighlight lang="j"> (,. addps ,. digrt) 627615 39390 588225 393900588225
 
<lang J> (, addper, digrot)&> 627615 39390 588225 393900588225
627615 2 9
39390 2 6
588225 2 3
393900588225 2 9</lang>
 
8 digrt 8b4321
3
8 addps 8b4321
2</syntaxhighlight>
 
Here's an equality operator for comparing these base 10 digital roots:
<syntaxhighlight lang="j">equals=: =&(9&|)"0</syntaxhighlight>
 
Table of results:
<lang J>equals=: =&(9&|)"0</lang>
<syntaxhighlight lang="j"> equals table i. 10
 
table of results:
 
<lang J> equals table i. 10
┌──────┬───────────────────┐
│equals│0 1 2 3 4 5 6 7 8 9│
Line 2,337 ⟶ 2,471:
│8 │0 0 0 0 0 0 0 0 1 0│
│9 │1 0 0 0 0 0 0 0 0 1│
└──────┴───────────────────┘</langsyntaxhighlight>
 
Note that these routines merely calculate results, which are numbers. If you want the result to be displayed in some other base, converting the result from numbers to character strings needs an additional step. Since that's currently not a part of the task, this is left as an exercise for the reader.
If digital roots other than 10 are desired, the modifier ~&10 can be removed from the above definitions of <code>digrot</code> and <code>addper</code>, and the base can be supplied as a left argument. Since this is a simplification, these definitions are shown here:
 
<lang J>digrt=: +/@(#.inv)^:_
addpr=: _1 + [: # +/@(#.inv)^:a:</lang>
 
Note that these routines merely calculate results, which are numbers. If you want the result to be displayed in some other base converting the result from numbers to character strings needs an additional step. Since that's currently not a part of the task, this is left as an exercise for the reader.
 
Example use (note: names spelled slightly different for the updated definitions):
 
<lang J> 10 digrt 627615
9
10 addpr 627615
2</lang>
 
=={{header|Janet}}==
<syntaxhighlight lang="janet">
(defn numbers [s] (filter (fn [y] (and (<= y 9) (>= y 0))) (map (fn [z] (- z 48)) (string/bytes s))))
(defn summa [s] (reduce (fn [x y] (+ x y)) 0 (numbers s)))
(defn minsumma [x p]
(if (<= x 9)
[x p]
(minsumma (summa (string/format "%d" x)) (+ 1 p))))
(defn test [t] (printf "%j" (minsumma (summa t) 1)))
(test "627615")
(test "39390")
(test "588225")
(test "393900588225")
(test "19999999999999999999999999999999999999999999999999999999999999999999999999999999999999")
(test "192348-0347203478-20483298402-39482-04720348-20394823-058720375204820-394823842-049802-93482-034892-3")
</syntaxhighlight>
{{out}}
<pre>
(9 2)
(6 2)
(3 2)
(9 2)
(1 4)
(6 3)
</pre>
=={{header|Java}}==
;<nowiki>Code:</nowiki>
<langsyntaxhighlight lang="java">import java.math.BigInteger;
 
class DigitalRoot
Line 2,385 ⟶ 2,532:
}
}
}</langsyntaxhighlight>
{{out|Example}}
<pre>java DigitalRoot 627615 39390 588225 393900588225
Line 2,394 ⟶ 2,541:
 
=={{header|JavaScript}}==
<langsyntaxhighlight JavaScriptlang="javascript">/// Digital root of 'x' in base 'b'.
/// @return {addpers, digrt}
function digitalRootBase(x,b) {
Line 2,409 ⟶ 2,556:
rootobj.addpers += 1;
return rootobj;
}</langsyntaxhighlight>
 
=={{header|jq}}==
Line 2,415 ⟶ 2,562:
 
digital_root(n) is defined here for decimals and strings representing decimals.
<langsyntaxhighlight lang="jq">def do_until(condition; next):
def u: if condition then . else (next|u) end;
u;
Line 2,434 ⟶ 2,581:
| "\(.): \($in[.])";
 
def rjust(n): tostring | (n-length)*" " + .;</langsyntaxhighlight>
'''Examples''':
<langsyntaxhighlight lang="jq">(
" i : [DR, P]",
(961038, 923594037444, 670033, 448944221089
Line 2,443 ⟶ 2,590:
),
"",
"digital_root(\"1\" * 100000) => \(digital_root( "1" * 100000))"</langsyntaxhighlight>
{{out}}
<langsyntaxhighlight lang="sh">$ jq -M -n -r -c -f Digital_root.jq
 
i : [DR, P]
Line 2,453 ⟶ 2,600:
448944221089: [1,3]
 
digital_root("1" * 100000) => [1,2]</langsyntaxhighlight>
 
=={{header|Julia}}==
{{works with|Julia|0.6}}
 
<langsyntaxhighlight lang="julia">function digitalroot(n::Integer, bs::Integer=10)
if n < 0 || bs < 2 throw(DomainError()) end
ds, pers = n, 0
Line 2,471 ⟶ 2,618:
pers, ds = digitalroot(i)
println(i, " has persistence ", pers, " and digital root ", ds)
end</langsyntaxhighlight>
 
{{out}}
Line 2,481 ⟶ 2,628:
 
=={{header|K}}==
<syntaxhighlight lang="k">
<lang K>
/ print digital root and additive persistence
prt: {`"Digital root = ", x, `"Additive persistence = ",y}
Line 2,488 ⟶ 2,635:
/ compute digital root and additive persistence
digroot: {sm::sumdig x; ap::0; (9<){sm::sumdig x;ap::ap+1; x:sm}/x; prt[sm;ap]}
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,509 ⟶ 2,656:
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">// version 1.0.6
 
fun sumDigits(n: Long): Int = when {
Line 2,544 ⟶ 2,691:
println("${n.toString().padEnd(12)} has additive persistence $ap and digital root of $dr")
}
}</langsyntaxhighlight>
 
{{out}}
Line 2,560 ⟶ 2,707:
=={{header|Lua}}==
With function sum_digits from [http://rosettacode.org/wiki/Sum_digits_of_an_integer#Lua]
<langsyntaxhighlight lang="lua">function digital_root(n, base)
p = 0
while n > 9.5 do
Line 2,572 ⟶ 2,719:
print(digital_root(39390, 10))
print(digital_root(588225, 10))
print(digital_root(393900588225, 10))</langsyntaxhighlight>
{{out}}
<pre>9 2
Line 2,581 ⟶ 2,728:
=={{header|MAD}}==
 
<langsyntaxhighlight MADlang="mad"> NORMAL MODE IS INTEGER
VECTOR VALUES INP = $I12*$
VECTOR VALUES OUTP = $I12,S1,I12*$
Line 2,603 ⟶ 2,750:
TRANSFER TO RDNUM
END OF CONDITIONAL
END OF PROGRAM</langsyntaxhighlight>
 
{{out}}
Line 2,623 ⟶ 2,770:
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">seq[n_, b_] := FixedPointList[Total[IntegerDigits[#, b]] &, n];
root[n_Integer, base_: 10] := If[base == 10, #, BaseForm[#, base]] &[Last[seq[n, base]]]
persistance[n_Integer, base_: 10] := Length[seq[n, base]] - 2;</langsyntaxhighlight>
{{out}}
<pre> root /@ {627615, 39390, 588225 , 393900, 588225, 670033, 448944221089}
Line 2,636 ⟶ 2,783:
f
16</pre>
 
=={{header|Maxima}}==
<syntaxhighlight lang="maxima">
/* Function that returns a list of digits given a nonnegative integer */
decompose(num) := block([digits, remainder],
digits: [],
while num > 0 do
(remainder: mod(num, 10),
digits: cons(remainder, digits),
num: floor(num/10)),
digits
)$
 
/* Function that given a positive integer returns the sum of their digits */
auxdig(n):=block(decompose(n),apply("+",%%));
 
/* Function that given a positive integer returns a list of two: the additive persistence and the digital root */
digrt(n):=block([additive_persistence:0,digital_root:n],
while length(decompose(digital_root))>1 do (digital_root:auxdig(digital_root),additive_persistence:additive_persistence+1),
[additive_persistence,digital_root]);
 
/* Examples */
digrt(627615);
digrt(39390);
digrt(588225);
digrt(393900588225);
</syntaxhighlight>
{{out}}
<pre>
[2,9]
[2,6]
[2,3]
[2,9]
</pre>
 
=={{header|MiniScript}}==
<syntaxhighlight lang="miniscript">testNumbers = [627615, 39390, 588225, 393900588225, 45, 9991]
pad = function(n, width)
return (n + " " * width)[:width]
end function
 
getDigitalRoot = function(n)
persistance = 0
while floor(log(n)) > 0
sum = 0
while n > 0
sum += n % 10
n = floor(n / 10)
end while
n = sum
persistance += 1
end while
return [n, persistance]
end function
 
for num in testNumbers
digRoot = getDigitalRoot(num)
print pad(num, 12), ""
print " has a digital root ", ""
print digRoot[0], ""
print " and additive persistance ",""
print digRoot[1]
end for</syntaxhighlight>
{{out}}
<pre>627615 has a digital root 9 and additive persistance 2
39390 has a digital root 6 and additive persistance 2
588225 has a digital root 3 and additive persistance 2
393900588225 has a digital root 9 and additive persistance 2
45 has a digital root 9 and additive persistance 1
9991 has a digital root 1 and additive persistance 3
</pre>
 
=={{header|Modula-2}}==
<langsyntaxhighlight lang="modula2">MODULE DigitalRoot;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;
Line 2,688 ⟶ 2,906:
 
ReadChar
END DigitalRoot.</langsyntaxhighlight>
 
=={{header|Modula-3}}==
{{trans|Modula-2}}
<langsyntaxhighlight lang="modula3">MODULE DigitalRoot EXPORTS Main;
 
IMPORT IO;
Line 2,733 ⟶ 2,951:
LongInt(R.R)));
END;
END DigitalRoot.</langsyntaxhighlight>
 
=={{header|Nanoquery}}==
{{trans|Python}}
<langsyntaxhighlight Nanoquerylang="nanoquery">def digital_root(n)
ap = 0
n = +(int(n))
Line 2,759 ⟶ 2,977:
println format("%12d has additive persistence %2d and digital root %d.", n, aproot[0], aproot[1])
end
end</langsyntaxhighlight>
 
{{out}}
Line 2,769 ⟶ 2,987:
 
=={{header|NetRexx}}==
<langsyntaxhighlight NetRexxlang="netrexx">/* NetRexx ************************************************************
* Test digroot
**********************************************************************/
Line 2,802 ⟶ 3,020:
n=s /* the 'new' number */
End
return n p /* return root and persistence */</langsyntaxhighlight>
{{out}}
<pre>
Line 2,815 ⟶ 3,033:
 
=={{header|Nim}}==
<langsyntaxhighlight lang="nim">import strutils
 
proc droot(n: int64): auto =
Line 2,828 ⟶ 3,046:
for n in [627615'i64, 39390'i64, 588225'i64, 393900588225'i64]:
let (a, d) = droot(n)
echo align($n, 12)," has additive persistence ",a," and digital root of ",d</langsyntaxhighlight>
{{out}}
<pre> 627615 has additive persistence 2 and digital root of 9
Line 2,834 ⟶ 3,052:
588225 has additive persistence 2 and digital root of 3
393900588225 has additive persistence 2 and digital root of 9</pre>
 
=={{header|OCaml}}==
<syntaxhighlight lang="ocaml">let rec digit_sum b n =
if n < b then n else digit_sum b (n / b) + n mod b
 
let digital_root b n =
let rec loop a x =
if x < b then a, x else loop (succ a) (digit_sum b x)
in
loop 0 n
 
let () =
let pr_fmt n (p, r) =
Printf.printf "%u: additive persistence = %u, digital root = %u\n" n p r
in
List.iter
(fun n -> pr_fmt n (digital_root 10 n))
[627615; 39390; 588225; 393900588225]</syntaxhighlight>
{{out}}
<pre>
627615: additive persistence = 2, digital root = 9
39390: additive persistence = 2, digital root = 6
588225: additive persistence = 2, digital root = 3
393900588225: additive persistence = 2, digital root = 9
</pre>
 
=={{header|Oforth}}==
Line 2,839 ⟶ 3,082:
Using result of sum digit task :
 
<langsyntaxhighlight Oforthlang="oforth">: sumDigits(n, base) 0 while(n) [ n base /mod ->n + ] ;
 
: digitalRoot(n, base)
0 while(n 9 >) [ 1 + sumDigits(n, base) ->n ] n swap Pair new ;</langsyntaxhighlight>
 
{{out}}
Line 2,851 ⟶ 3,094:
 
=={{header|Ol}}==
<langsyntaxhighlight lang="scheme">
(define (digital-root num)
(if (less? num 10)
Line 2,864 ⟶ 3,107:
(print (digital-root 588225))
(print (digital-root 393900588225))
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 2,874 ⟶ 3,117:
 
=={{header|PARI/GP}}==
<langsyntaxhighlight lang="parigp">dsum(n)=my(s); while(n, s+=n%10; n\=10); s
additivePersistence(n)=my(s); while(n>9, s++; n=dsum(n)); s
digitalRoot(n)=if(n, (n-1)%9+1, 0)</langsyntaxhighlight>
 
=={{header|Pascal}}==
{{works with|Free Pascal|2.6.2}}
<langsyntaxhighlight Pascallang="pascal">program DigitalRoot;
 
{$mode objfpc}{$H+}
Line 2,949 ⟶ 3,192:
 
ReadLn;
End.</langsyntaxhighlight>
{{out}}
<pre>--- Examples in 10-Base ---
Line 2,963 ⟶ 3,206:
 
=={{header|Perl}}==
<langsyntaxhighlight lang="perl">#!perl
use strict;
use warnings;
Line 3,013 ⟶ 3,256:
print "\n";
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 3,060 ⟶ 3,303:
 
=={{header|Phix}}==
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
Line 3,083 ⟶ 3,326:
<span style="color: #000000;">digital_root</span><span style="color: #0000FF;">(</span><span style="color: #000000;">588225</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">digital_root</span><span style="color: #0000FF;">(</span><span style="color: #000000;">393900588225</span><span style="color: #0000FF;">)</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 3,090 ⟶ 3,333:
588225 root: 3 persistence: 2
393900588225 root: 9 persistence: 2
</pre>
 
=={{header|PHP}}==
{{trans|TypeScript}}
<syntaxhighlight lang="php">
<?php
// Digital root
 
function rootAndPers($n, $bas)
// Calculate digital root and persistance
{
$pers = 0;
while ($n >= $bas) {
$s = 0;
do {
$s += $n % $bas;
$n = floor($n / $bas);
} while ($n > 0);
$pers++;
$n = $s;
}
return array($n, $pers);
}
 
foreach ([1, 14, 267, 8128, 39390, 588225, 627615] as $a) {
list($root, $pers) = rootAndPers($a, 10);
echo str_pad($a, 7, ' ', STR_PAD_LEFT);
echo str_pad($pers, 6, ' ', STR_PAD_LEFT);
echo str_pad($root, 6, ' ', STR_PAD_LEFT), PHP_EOL;
}
?>
</syntaxhighlight>
{{out}}
<pre>
1 0 1
14 1 5
267 2 6
8128 3 1
39390 2 6
588225 2 3
627615 2 9
</pre>
 
=={{header|Picat}}==
<langsyntaxhighlight Picatlang="picat">go =>
foreach(N in [627615,39390,588225,393900588225,
58142718981673030403681039458302204471300738980834668522257090844071443085937])
Line 3,110 ⟶ 3,394:
Sum := sum([I.to_integer() : I in Sum.to_string()]),
Persistence := Persistence + 1
end.</langsyntaxhighlight>
 
{{out}}
Line 3,120 ⟶ 3,404:
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(for N (627615 39390 588225 393900588225)
(for ((A . I) N T (sum format (chop I)))
(T (> 10 I)
(prinl N " has additive persistance " (dec A) " and digital root of " I ";") ) ) )</langsyntaxhighlight>
{{out}}
<pre>627615 has additive persistance 2 and digital root of 9;
Line 3,131 ⟶ 3,415:
 
=={{header|PL/I}}==
<langsyntaxhighlight lang="pli"> digrt: Proc Options(main);
/* REXX ***************************************************************
* Test digroot
Line 3,189 ⟶ 3,473:
Return(res);
End;
End;</langsyntaxhighlight>
{{out}}
<pre>
Line 3,199 ⟶ 3,483:
</pre>
Alternative:
<langsyntaxhighlight PLlang="pl/Ii">digital: procedure options (main); /* 29 April 2014 */
declare 1 pict union,
2 x picture '9999999999999',
Line 3,213 ⟶ 3,497:
end;
 
end digital;</langsyntaxhighlight>
Results:
<pre>
Line 3,226 ⟶ 3,510:
=={{header|PL/M}}==
Similar to the Algol W version, this sample handles numbers larger than 65535 ( the largest integer supported by the original 8080 PL/M compiler ) by splitting the numbers into 3 parts. Note that the original 8080 PL/M compiler only supports 8 and 16 bit unsigned values.
<langsyntaxhighlight lang="plm">100H: /* SHOW THE DIGITAL ROOT AND PERSISTENCE OF SOME NUMBERS */
 
/* BDOS SYSTEM CALL */
Line 3,327 ⟶ 3,611:
CALL PRINT$DR$ANDPERSISTENCE( 3939, 0058, 8225 );
 
EOF</langsyntaxhighlight>
{{out}}
<pre>
Line 3,337 ⟶ 3,621:
 
=={{header|Potion}}==
<langsyntaxhighlight lang="potion">digital = (x) :
dr = x string # Digital Root.
ap = 0 # Additive Persistence.
Line 3,353 ⟶ 3,637:
digital(39390)
digital(588225)
digital(393900588225)</langsyntaxhighlight>
 
=={{header|PowerShell}}==
Uses the recursive function from the 'Sum Digits of an Integer' task.
<langsyntaxhighlight Powershelllang="powershell">function Get-DigitalRoot ($n)
{
function Get-Digitalsum ($n)
Line 3,375 ⟶ 3,659:
}
$DigitalRoot
}</langsyntaxhighlight>
Command:
<pre>
Line 3,387 ⟶ 3,671:
</pre>
===Alternative Method===
<langsyntaxhighlight lang="powershell">function Get-DigitalRoot {
param($n)
$ap = 0
Line 3,395 ⟶ 3,679:
AdditivePersistence = $ap
}
}</langsyntaxhighlight>
Command:
<pre>
Line 3,410 ⟶ 3,694:
=={{header|Prolog}}==
{{works with|SWI Prolog}}
<langsyntaxhighlight lang="prolog">digit_sum(N, Base, Sum):-
digit_sum(N, Base, Sum, 0).
 
Line 3,442 ⟶ 3,726:
test_digital_root(588225, 10),
test_digital_root(393900588225, 10),
test_digital_root(685943443231217865409, 10).</langsyntaxhighlight>
 
{{out}}
Line 3,454 ⟶ 3,738:
 
=={{header|PureBasic}}==
<langsyntaxhighlight lang="purebasic">; if you just want the DigitalRoot
; Procedure.q DigitalRoot(N.q) apparently will do
; i must have missed something because it seems too simple
Line 3,502 ⟶ 3,786:
; cw(DigitalRootandPersistance(N))
Debug DigitalRootandPersistance(N)
Next</langsyntaxhighlight>
{{out}}
<pre>
Line 3,513 ⟶ 3,797:
=={{header|Python}}==
===Procedural===
<langsyntaxhighlight lang="python">def digital_root (n):
ap = 0
n = abs(int(n))
Line 3,525 ⟶ 3,809:
persistance, root = digital_root(n)
print("%12i has additive persistance %2i and digital root %i."
% (n, persistance, root))</langsyntaxhighlight>
 
{{out}}
Line 3,542 ⟶ 3,826:
The tabulation of '''f(x)''' values can be derived by a generalised function over the '''f''', a header string '''s''', and the input '''xs''':
 
<langsyntaxhighlight lang="python">from functools import (reduce)
 
 
Line 3,605 ⟶ 3,889:
 
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{Out}}
<pre>Integer -> (additive persistence, digital root):
Line 3,616 ⟶ 3,900:
=={{header|Quackery}}==
 
<langsyntaxhighlight Quackerylang="quackery">[ abs 0 swap
[ base share /mod
rot + swap
Line 3,638 ⟶ 3,922:
39390 task
588225 task
393900588225 task</langsyntaxhighlight>
 
'''Output:'''
Line 3,650 ⟶ 3,934:
=={{header|R}}==
The code prints digital root and persistence seperately
<langsyntaxhighlight Rlang="r">y=1
digital_root=function(n){
x=sum(as.numeric(unlist(strsplit(as.character(n),""))))
Line 3,662 ⟶ 3,946:
return(k)
}
print("Given number has additive persistence",y)</langsyntaxhighlight>
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">#lang racket
(define/contract (additive-persistence/digital-root n (ap 0))
(->* (natural-number/c) (natural-number/c) (values natural-number/c natural-number/c))
Line 3,689 ⟶ 3,973:
(check-equal? a ap)
(check-equal? d dr)
(printf ":~a has additive persistence ~a and digital root of ~a;~%" n a d)))))</langsyntaxhighlight>
{{out}}
<pre>627615 has additive persistence 2 and digital root of 9
Line 3,698 ⟶ 3,982:
=={{header|Raku}}==
(formerly Perl 6)
<syntaxhighlight lang="raku" perl6line>sub digrootdigital-root ($r, :$base = 10) {
my $root = $r.base($base);
my $persistence = 0;
while $root.chars > 1 {
$root = [+]($root.comb.map({:36($_)})).sum.base($base);
$persistence++;
}
Line 3,718 ⟶ 4,002:
for @testnums -> $n {
printf ":$b\<%s>\ndigital root %s, persistence %s\n\n",
$n.base($b), digrootdigital-root $n, :base($b);
}
}</langsyntaxhighlight>
{{out}}
<pre>:10<627615>
Line 3,781 ⟶ 4,065:
:36<37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVNCBWNRVNOJYPD>
digital root H, persistence 3</pre>
Or if you are more inclined to the functional programming persuasion, you can use the <tt>...…</tt> sequence operator to calculate the values without side effects:
<syntaxhighlight lang="raku" perl6line>sub digrootdigital-root ($r, :$base = 10) {
my &sum = { [+](.comb.map({:36($_)})).sum.base($base) }
 
return .[*-1], .elems-1
given $r.base($base), &sum ... … { .chars == 1 }
}</langsyntaxhighlight>
Output same as above.
 
=={{header|REXX}}==
===version 1===
<langsyntaxhighlight lang="rexx">/* REXX ***************************************************************
* Test digroot
**********************************************************************/
Line 3,817 ⟶ 4,102:
n=s /* the 'new' number */
End
return n p /* return root and persistence */</langsyntaxhighlight>
 
===version 2===
<langsyntaxhighlight lang="rexx">/*REXX program calculates and displays the digital root and additive persistence. */
say 'digital additive' /*display the 1st line of the header.*/
say " root persistence" center('number',77) /* " " 2nd " " " " */
Line 3,838 ⟶ 4,123:
x= $; L= length(x) /*a new num, it may be multi─digit*/
end /*pers*/
return center(x, 7) center(pers, 11) z /*return a nicely formatted line. */</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the internal default inputs:}}
<pre>
Line 3,854 ⟶ 4,139:
===version 3===
This subroutine version can also handle numbers with signs, &nbsp; blanks, &nbsp; commas, &nbsp; and/or decimal points.
<langsyntaxhighlight lang="rexx">/*REXX program calculates and displays the digital root and additive persistence. */
say 'digital additive' /*display the 1st line of the header.*/
say " root persistence" center('number',77) /* " " 2nd " " " " */
Line 3,873 ⟶ 4,158:
x= $; L=length(x) /*a new #, it may be multi─digit.*/
end /*pers*/
return center(x,7) center(pers,11) ox /*return a nicely formatted line.*/</langsyntaxhighlight>
{{out|output|text=&nbsp; is identical to the 2<sup>nd</sup> REXX version.}} <br><br>
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
c = 0
see "Digital root of 627615 is " + digitRoot(627615, 10) + " persistance is " + c + nl
Line 3,900 ⟶ 4,185:
end
return s
</syntaxhighlight>
</lang>
 
=={{header|RPL}}==
Base 10 only. For other bases, use <code>DIGITS</code> from [[Factors of an integer#RPL]] instead of <code>∑DGIT</code> below, which is more compact - but works only in base 10.
≪ 0 SWAP
'''DO''' 10 / LAST MOD ROT + RND SWAP FLOOR
'''UNTIL''' DUP NOT '''END''' DROP
≫ ''''∑DGIT'''' STO
≪ 0 '''WHILE''' OVER 9 > '''REPEAT'''
1 + SWAP '''∑DGIT''' SWAP '''END''' R→C
≫ ''''DROOT'''' STO
 
≪ { 627615 39390 588225 393900588225 55 } → cases
≪ {} 1 cases SIZE '''FOR''' j cases j GET '''DROOT''' + '''NEXT'''
≫ ≫ EVAL
{out}
<pre>
1: { (9,2) (6,2) (3,2) (9,2) (1,2) }
</pre>
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">class String
def digroot_persistence(base=10)
num = self.to_i(base)
Line 3,926 ⟶ 4,230:
["50YE8N29", 36]].each do |(str, base)|
puts format % [str, base, *str.digroot_persistence(base)]
end</langsyntaxhighlight>
{{out}}
<pre>
Line 3,943 ⟶ 4,247:
 
=={{header|Run BASIC}}==
<langsyntaxhighlight lang="runbasic">print "Digital root of 627615 is "; digitRoot$(627615, 10)
print "Digital root of 39390 is "; digitRoot$(39390, 10)
print "Digital root of 588225 is "; digitRoot$(588225, 10)
Line 3,965 ⟶ 4,269:
wend
digSum = s
end function</langsyntaxhighlight>
{{out}}
<pre>Digital root of 627615 is 9 persistance is 2
Line 3,974 ⟶ 4,278:
 
=={{header|Rust}}==
<langsyntaxhighlight lang="rust">fn sum_digits(mut n: u64, base: u64) -> u64 {
let mut sum = 0u64;
while n > 0 {
Line 4,016 ⟶ 4,320:
pers);
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,028 ⟶ 4,332:
0xd60141 has digital root 0xa and additive persistance 0x2
0x12343210 has digital root 0x1 and additive persistance 0x2
</pre>
 
=={{header|S-BASIC}}==
We operate on the number as a string to avoid the limitations of S-BASIC's 16-bit integer type
<syntaxhighlight lang="BASIC">
rem - return the digital sum of n represented as a string
function digitalsum(nstr = string) = integer
var i, slen, sum = integer
var ch = char
slen = len(nstr)
sum = 0
for i = 1 to slen
ch = mid(nstr, i, 1)
rem - don't process leading or embedded spaces, etc.
if ch >= '0' and ch <= '9' then
sum = sum + (ch - '0')
next i
end = sum
 
var nstr = string
var droot, pers = integer
 
0again
rem - input1 does not advance to next line; control-C will exit
input1 "What number"; nstr
droot = digitalsum(nstr)
pers = 1
while droot > 9 do
begin
droot = digitalsum(str$(droot))
pers = pers + 1
end
print " digital root ="; droot; " persistence ="; pers
goto 0again
 
end
</syntaxhighlight>
{{out}}
Control-C at the prompt provides a quick and dirty exit
<pre>
What number ? 627615 digital root = 9 persistence = 2
What number ? 39390 digital root = 6 persistence = 2
What number ? 588225 digital root = 3 persistence = 2
What number ? 393900588225 digital root = 9 persistence = 2
What number ?
</pre>
 
=={{header|Scala}}==
<langsyntaxhighlight lang="scala">def digitalRoot(x:BigInt, base:Int=10):(Int,Int) = {
def sumDigits(x:BigInt):Int=x.toString(base) map (_.asDigit) sum
def loop(s:Int, c:Int):(Int,Int)=if (s < 10) (s, c) else loop(sumDigits(s), c+1)
Line 4,042 ⟶ 4,391:
}
var (s, c)=digitalRoot(0x7e0, 16)
println("%x has additive persistance %d and digital root of %d".format(0x7e0,c,s))</langsyntaxhighlight>
{{out}}
<pre>627615 has additive persistance 2 and digital root of 9
Line 4,051 ⟶ 4,400:
=={{header|Scheme}}==
{{works with|Chez Scheme}}
<langsyntaxhighlight lang="scheme">; Convert an integer into a list of its digits.
 
(define integer->list
Line 4,085 ⟶ 4,434:
(aa (adr-ap int)))
(printf "~13@a ~6@a ~6@a~%" int (car aa) (cdr aa))
(rowloop (cdr intlist)))))</langsyntaxhighlight>
{{out}}
<pre> Integer Root Pers.
Line 4,097 ⟶ 4,446:
 
=={{header|Seed7}}==
<langsyntaxhighlight lang="seed7">$ include "seed7_05.s7i";
include "bigint.s7i";
 
Line 4,126 ⟶ 4,475:
writeln(num <& " has additive persistence " <& persistence <& " and digital root of " <& root);
end for;
end func;</langsyntaxhighlight>
{{out}}
<pre>
Line 4,137 ⟶ 4,486:
=={{header|Sidef}}==
{{trans|Perl}}
<langsyntaxhighlight lang="ruby">func digroot (r, base = 10) {
var root = r.base(base)
var persistence = 0
Line 4,161 ⟶ 4,510:
}
print "\n"
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,209 ⟶ 4,558:
=={{header|Smalltalk}}==
{{works with|Smalltalk/X}}
<langsyntaxhighlight lang="smalltalk">digitalRoot :=
[:nr :arIn |
r := (nr printString asArray collect:#digitValue) sum.
Line 4,225 ⟶ 4,574:
Transcript showCR:'%1 has digitalRoot %3 and Additive Resistance %2'
withArguments:{nr},(digitalRoot value:nr value:0)
]</langsyntaxhighlight>
{{out}}
<pre>39390 has digitalRoot 6 and Additive Resistance 2
Line 4,235 ⟶ 4,584:
 
=={{header|SmileBASIC}}==
<langsyntaxhighlight lang="smilebasic">DEF DIGITAL_ROOT N OUT DR,AP
AP=0
DR=N
Line 4,247 ⟶ 4,596:
DR=NEWDR
WEND
END</langsyntaxhighlight>
 
=={{header|Tcl}}==
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
proc digitalroot num {
for {set p 0} {[string length $num] > 1} {incr p} {
Line 4,261 ⟶ 4,610:
lassign [digitalroot $n] p r
puts [format "$n has additive persistence $p and digital root of $r"]
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,271 ⟶ 4,620:
 
=={{header|TI-83 BASIC}}==
<langsyntaxhighlight lang="ti83b">:ClrHome
­:1→X
:Input ">",Str1
Line 4,291 ⟶ 4,640:
:ClrHome
:Disp Str2,"DIGITAL ROOT",expr(Str1),"ADDITIVE","PERSISTENCE",X
:Pause</langsyntaxhighlight>
{{out}}
<pre>627615
Line 4,311 ⟶ 4,660:
== {{header|TypeScript}} ==
{{trans|ASIC}}
<langsyntaxhighlight lang="javascript">// Digital root
function rootAndPers(n: number, bas: number): [number, number] {
Line 4,334 ⟶ 4,683:
rp[1].toString().padStart(6, ' ') + rp[0].toString().padStart(6, ' '));
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 4,348 ⟶ 4,697:
=={{header|uBasic/4tH}}==
{{trans|BBC Basic}}
<syntaxhighlight lang="text">PRINT "Digital root of 627615 is "; FUNC(_FNdigitalroot(627615, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"
 
Line 4,380 ⟶ 4,729:
a@ = c@
Loop
Return (d@)</langsyntaxhighlight>
{{Out}}
<pre>Digital root of 627615 is 9 (additive persistence 2)
Line 4,390 ⟶ 4,739:
 
=={{header|UNIX Shell}}==
<langsyntaxhighlight lang="bash">#!/usr/bin/env bash
 
numbers=(627615 39390 588225 393900588225 55)
Line 4,404 ⟶ 4,753:
echo -e "${number} has additive persistence ${iterations} and digital root ${root}"
unset iterations
done | column -t</langsyntaxhighlight>
{{ Out }}
<pre>627615 has additive persistence 2 and digital root 9
Line 4,413 ⟶ 4,762:
 
=={{header|VBA}}==
<langsyntaxhighlight lang="vb">Option Base 1
Private Sub digital_root(n As Variant)
Dim s As String, t() As Integer
Line 4,437 ⟶ 4,786:
digital_root 588225
digital_root 393900588225#
End Sub</langsyntaxhighlight>{{out}}
<pre> 627615 has additive persistence 2 and digital root of 9;
39390 has additive persistence 2 and digital root of 6;
Line 4,444 ⟶ 4,793:
 
=={{header|VBScript}}==
<langsyntaxhighlight lang="vb">Function digital_root(n)
ap = 0
Do Until Len(n) = 1
Line 4,458 ⟶ 4,807:
End Function
 
WScript.StdOut.Write digital_root(WScript.Arguments(0))</langsyntaxhighlight>
 
{{Out}}
Line 4,479 ⟶ 4,828:
=={{header|Visual Basic .NET}}==
{{trans|C#}}
<langsyntaxhighlight lang="vbnet">Module Module1
 
Function DigitalRoot(num As Long) As Tuple(Of Integer, Integer)
Line 4,498 ⟶ 4,847:
End Sub
 
End Module</langsyntaxhighlight>
{{out}}
<pre>627615 has additive persistence 2 and digital root 9
Line 4,505 ⟶ 4,854:
393900588225 has additive persistence 2 and digital root 9</pre>
 
=={{header|V (Vlang)}}==
{{trans|Go}}
<syntaxhighlight lang="v (vlang)">import strconv
 
fn sum(ii u64, base int) int {
Line 4,572 ⟶ 4,921:
}
}
}</langsyntaxhighlight>
 
{{out}}
Line 4,594 ⟶ 4,943:
 
=={{header|Wortel}}==
<langsyntaxhighlight lang="wortel">@let {
sumDigits ^(@sum @arr)
drootl &\@rangef [. sumDigits ^(\~>1 #@arr)]
Line 4,606 ⟶ 4,955:
&n !console.log "{n}: {!droot n} {!apers n} {@str !drootl n}"
]
}</langsyntaxhighlight>
{{out}}
<pre>[number]: [digital root] [additive persistence] [intermediate sums]
Line 4,617 ⟶ 4,966:
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
<langsyntaxhighlight ecmascriptlang="wren">import "./fmt" for Fmt
 
var sumDigits = Fn.new { |n|
Line 4,646 ⟶ 4,995:
var ap = res[1]
Fmt.print("$,15d has additive persistence $d and digital root of $d", n, ap, dr)
}</langsyntaxhighlight>
 
{{out}}
Line 4,664 ⟶ 5,013:
precision needed.
 
<langsyntaxhighlight XPL0lang="xpl0">include c:\cxpl\codes; \intrinsic 'code' declarations
 
func DRoot(N, B, P); \Return digital root and persistance P
Line 4,689 ⟶ 5,038:
IntOut(0, Pers); ChOut(0, ^ ); IntOut(0, Root); CrLf(0);
];
]</langsyntaxhighlight>
{{out}}
<pre>
Line 4,699 ⟶ 5,048:
 
=={{header|zkl}}==
<langsyntaxhighlight lang="zkl">fcn sum(n,b){ n.split(b).sum(0) }
fcn droot(n,b=10,X=0) // -->(digital root, additive persistence)
{ if(n<b)return(n,X); return(self.fcn(sum(n,b),b,X+1)) }</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">droot(627615)
droot(39390)
droot(588225)
droot(393900588225)
droot(7,2)
droot(0x7e0,16)</langsyntaxhighlight>
{{out}}
<pre>
Line 4,719 ⟶ 5,068:
 
=={{header|zonnon}}==
<langsyntaxhighlight lang="zonnon">
module Main;
type
Line 4,760 ⟶ 5,109:
write(max(integer{64}):22,":> ");DigitalRoot(max(integer{64})).Writeln;
end Main.
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 4,772 ⟶ 5,121:
=={{header|ZX Spectrum Basic}}==
{{trans|Run BASIC}}
<langsyntaxhighlight lang="zxbasic">10 DATA 4,627615,39390,588225,9992
20 READ j: LET b=10
30 FOR i=1 TO j
Line 4,789 ⟶ 5,138:
2020 IF n<>0 THEN LET q=INT (n/b): LET s=s+n-q*b: LET n=q: GO TO 2020
2030 LET n=s
2040 RETURN</langsyntaxhighlight>
Nilsola
5

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/217530...361076"