Digital root: Difference between revisions
no edit summary
(Digital root en Malbolge) |
No edit summary |
||
(41 intermediate revisions by 26 users not shown) | |||
Line 27:
=={{header|11l}}==
{{trans|Python}}
<
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))</
{{out}}
<pre>
Line 48:
=={{header|360 Assembly}}==
<
DIGROOT CSECT
USING DIGROOT,R13 base register
Line 93:
XDEC DS CL12
YREGS
END DIGROOT</
{{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).
<
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;</
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).
<
procedure Compute_Root(N: Number;
Line 148:
end Compute_Root;
end Generic_Root;</
Finally the main program. The procedure "Print_Roots" is for our convenience.
<
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;</
{{out}}
Line 191:
=={{header|ALGOL 68}}==
<
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</
{{out}}
<pre>
Line 234:
=={{header|ALGOL W}}==
<
% calculates the digital root and persistence of an integer in base 10 %
Line 296:
printDigitalRootAndPersistence( 393900, 588225 )
end.</
{{out}}
<pre>
Line 306:
=={{header|AppleScript}}==
<
script math
to sum(L)
Line 327:
digitalroot(627615)</
{{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.
<
on run
set firstCol to justifyRight(18, space)
Line 667:
set my text item delimiters to dlm
s
end unlines</
{{Out}}
<pre>Base 10:
Line 677:
=={{header|Applesoft BASIC}}==
<
2 FOR E = 0 TO 1 STEP 0
3 GOSUB 7"READ
Line 763:
1000 DATA,30
1010 DATADIGITALROOT
63999DATA,</
{{out}}
<pre>627615 HAS ADDITIVE PERSISTENCE 2 AND DIGITAL ROOT 9;
Line 775:
{{trans|Ruby}}
<
persistence: 0
until [
Line 787:
a: droot i
print [i "has additive persistence" a\0 "and digital root of" a\1]
]</
{{out}}
Line 797:
=={{header|AutoHotkey}}==
<
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</
{{out}}
<pre> 30: Digital Root = 3, Additive Persistence = 1
Line 823:
=={{header|AWK}}==
<
BEGIN {
n = split("627615,39390,588225,393900588225,10,199",arr,",")
Line 847:
}
return(s)
}</
{{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.
<
'test inputs:
Line 885:
END IF
PRINT what; ": additive persistance "; c; ", digital root "; w
END SUB</
{{out}}
627615 : additive persistance 2 , digital root 9
39390 : additive persistance 2 , digital root 6
588225 : additive persistance 2 , digital root 3
==={{header|ASIC}}===
Compile with the ''Extended math'' option.
<syntaxhighlight lang="basic">
REM Digital root
DATA 1&, 14&, 267&, 8128&, 39390&, 588225&, 627615&
FOR I = 0 TO 6
READ A&
N& = A&
Base = 10
GOSUB CalcDRootAndPers:
PRINT A&;
PRINT Pers;
PRINT Root
NEXT I
END
CalcDRootAndPers:
REM Results: Root - digital root; Pers - persistance
Pers = 0
WHILE N& >= Base
S = 0
Loop:
NModBase& = N& MOD Base
S = S + NModBase&
N& = N& / Base
IF N& > 0 THEN Loop:
Pers = Pers + 1
N& = S
WEND
Root = N&
RETURN
</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|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}}
<syntaxhighlight lang="basic">
10 REM Digital root
20 FOR I=0 TO 6
30 READ A
40 N=A:B=10:GOSUB 500
50 PRINT SPC(7-LEN(STR$(A)));A;PERS;ROOT
60 NEXT I
70 DATA 1,14,267,8128,39390,588225,627615
80 END
490 REM ** Calculate digital root
495 REM and persistance
500 PERS=0
510 IF N<B THEN 590
520 S=0
530 S=S+N-INT(N/B)*B
540 N=INT(N/B)
550 IF N>0 THEN 530
560 PERS=PERS+1
570 N=S
580 GOTO 510
590 ROOT=N
600 RETURN
</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|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}}==
<
:: Batch File Implementation
:: (Base 10)
Line 931 ⟶ 1,096:
set inp2sum=%sum%
goto :cyc1
:: /THE FUNCTION</
{{out}}
<pre>(9876543214)
Line 949 ⟶ 1,114:
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<
PRINT "Digital root of 627615 is "; FNdigitalroot(627615, 10, p) ;
PRINT " (additive persistence " ; p ")"
Line 977 ⟶ 1,142:
n = q
ENDWHILE
= s</
{{out}}
<pre>
Line 990 ⟶ 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.
<
v\1:/+55p00<v\`\0::-"0"<~<
#>:55+%00g+^>9`+#v_+\ 1+\^
Line 997 ⟶ 1,162:
>$$00g\1+^@,+<v"Di",>#+ 5<
>:#,_$ . 5 5 ^>:#,_\.55+,v
^"Additive Persistence: "<</
{{out}} (multiple runs)
Line 1,014 ⟶ 1,179:
Digital root: 1
Additive Persistence: 3</pre>
=={{header|BQN}}==
A recursive implementation which takes the root and persistence in base 10.
Other bases can be used by changing the <code>DSum</code> function, which is derived from a [https://mlochbaum.github.io/bqncrate/ BQNcrate] idiom.
<syntaxhighlight lang="bqn">DSum ← +´10{⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)}
Root ← 0⊸{(×○⌊÷⟜10)◶⟨𝕨‿𝕩,(1+𝕨)⊸𝕊 Dsum⟩𝕩}
P ← •Show ⊢∾Root
P 627615
P 39390
P 588225
P 393900588225</syntaxhighlight>
<syntaxhighlight lang="text">⟨ 627615 2 9 ⟩
⟨ 39390 2 6 ⟩
⟨ 588225 2 3 ⟩
⟨ 393900588225 2 9 ⟩</syntaxhighlight>
[https://mlochbaum.github.io/BQN/try.html#code=RFN1bSDihpAgK8K0MTB74oy98J2Vl3zijIriiJjDt+KfnPCdlZfijZ8o4oaVMSvCt+KMivCdlZfii4bigbwx4oyI4oqiKX0KUm9vdCDihpAgMOKKuHsow5fil4vijIrDt+KfnDEwKeKXtuKfqPCdlajigL/wnZWpLCgxK/Cdlagp4oq48J2ViiBEc3Vt4p+p8J2VqX0KClAg4oaQIOKAolNob3cg4oqi4oi+Um9vdApQIDYyNzYxNQpQIDM5MzkwClAgNTg4MjI1ClAgMzkzOTAwNTg4MjI1Cg== Try It!]
=={{header|Bracmat}}==
<
= sum persistence n d
. !arg:(~>9.?)
Line 1,044 ⟶ 1,228:
?
| done
);</
{{out}}
<pre>627615 has additive persistence 2 and digital root of 9
Line 1,054 ⟶ 1,238:
=={{header|C}}==
<
int droot(long long int x, int base, int *pers)
Line 1,079 ⟶ 1,263:
return 0;
}</
=={{header|C sharp|C#}}==
<
using System.Linq;
Line 1,105 ⟶ 1,289:
}
}
}</
{{out}}
<pre>627615 has additive persistence 2 and digital root 9
Line 1,114 ⟶ 1,298:
=={{header|C++}}==
For details of SumDigits see: http://rosettacode.org/wiki/Sum_digits_of_an_integer
<
//
// Nigel Galloway. July 23rd., 2012
Line 1,143 ⟶ 1,327:
}
return 0;
}</
{{out}}
<pre>961038 has digital root 9 and additive persistance 2
Line 1,157 ⟶ 1,341:
=={{header|Clojure}}==
<syntaxhighlight lang="clojure">
(defn dig-root [value]
(let [digits (fn [n]
Line 1,170 ⟶ 1,354:
(recur (sum (digits n))
(inc step))))))
</syntaxhighlight>
{{out}}
Line 1,179 ⟶ 1,363:
{:n 393900588225, :add-persist 2, :digital-root 9})
</pre>
=={{header|CLU}}==
<syntaxhighlight lang="clu">sum_digits = proc (n, base: int) returns (int)
sum: int := 0
while n > 0 do
sum := sum + n // base
n := n / base
end
return (sum)
end sum_digits
digital_root = proc (n, base: int) returns (int, int)
persistence: int := 0
while n >= base do
persistence := persistence + 1
n := sum_digits(n, base)
end
return (n, persistence)
end digital_root
start_up = proc ()
po: stream := stream$primary_output()
tests: array[int] := array[int]$[627615, 39390, 588225, 393900588225]
for test: int in array[int]$elements(tests) do
root, persistence: int := digital_root(test, 10)
stream$putl(po, int$unparse(test)
|| " has additive persistence "
|| int$unparse(persistence)
|| " and digital root of "
|| int$unparse(root))
end
end start_up</syntaxhighlight>
{{out}}
<pre>627615 has additive persistence 2 and digital root of 9
39390 has additive persistence 2 and digital root of 6
588225 has additive persistence 2 and digital root of 3
393900588225 has additive persistence 2 and digital root of 9</pre>
=={{header|Common Lisp}}==
Using <code>SUM-DIGITS</code> from the task "[[Sum_digits_of_an_integer#Common_Lisp|Sum digits of an integer]]".
<
(loop for n = number then s
for ap = 1 then (1+ ap)
Line 1,192 ⟶ 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)))</
{{Out}}
<pre>627615 (base 10): additive persistence = 2, digital root = 9
Line 1,201 ⟶ 1,423:
=={{header|Component Pascal}}==
{{Works with|BlackBox Component Builder}}
<
MODULE DigitalRoot;
IMPORT StdLog, Strings, TextMappers, DevCommanders;
Line 1,242 ⟶ 1,464:
END Do;
END DigitalRoot.
</syntaxhighlight>
Execute:
^Q DigitalRoot.Do 627615 39390 588225 393900588~
Line 1,252 ⟶ 1,474:
393900588 Digital root: 9 Persistence: 2
</pre>
=={{header|COBOL}}==
<syntaxhighlight lang="cobol"> 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.</syntaxhighlight>
{{out}}
<pre> 627615: PERSISTENCE = 2, ROOT = 9
39390: PERSISTENCE = 2, ROOT = 6
588225: PERSISTENCE = 2, ROOT = 3
393900588225: PERSISTENCE = 2, ROOT = 9</pre>
=={{header|Cowgol}}==
<
# Calculate the digital root and additive persistance of a number
Line 1,291 ⟶ 1,565:
test(39390);
test(588225);
test(9992);</
{{out}}
Line 1,304 ⟶ 1,578:
If you just want the digital root, you can use this, which is almost 100x faster than calculating it with persistence:
<
max_single_digit = base - 1
n = n.abs
Line 1,316 ⟶ 1,590:
puts digital_root 39390
puts digital_root 588225
puts digital_root 7, base: 3</
{{out}}
Line 1,325 ⟶ 1,599:
The faster approach when calculating it with persistence uses exponentiation and log to avoid converting to and from strings.
<
n = n.abs
persistence = 0
Line 1,342 ⟶ 1,616:
puts digital_root_with_persistence 627615
puts digital_root_with_persistence 39390
puts digital_root_with_persistence 588225</
{{out}}
Line 1,350 ⟶ 1,624:
However, the string-conversion based solution is easiest to read.
<
n = n.abs
persistence = 0
Line 1,367 ⟶ 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</
{{out}}
Line 1,375 ⟶ 1,649:
=={{header|D}}==
<
std.traits;
Line 1,410 ⟶ 1,684:
foreach (immutable b; [2, 3, 8, 10, 16, 36])
writefln(f2, b, n.digitalRoot(b)[]); // Shortened output.
}</
{{out}}
<pre>101(2): additive persistance= 2, digital root= 1
Line 1,460 ⟶ 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).
<
=={{header|DCL}}==
<
$ count = 0
$ sum = x
Line 1,480 ⟶ 1,754:
$ goto loop1
$ done:
$ write sys$output p1, " has additive persistence ", count, " and digital root of ", sum</
{{out}}
<pre>$ @digital_root 627615
Line 1,491 ⟶ 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">
class
APPLICATION
Line 1,563 ⟶ 1,877:
end
end
</syntaxhighlight>
{{out}}
<pre>
Line 1,574 ⟶ 1,888:
=={{header|Elena}}==
{{trans|C#}}
ELENA
<
import system'routines;
import system'collections;
Line 1,588 ⟶ 1,902:
while (num > 9)
{
num := num.toPrintable().toArray().selectBy::(ch => ch.toInt() - 48).summarize(new LongInteger());
additivepersistence += 1
Line 1,599 ⟶ 1,913:
public program()
{
new long[]{627615l, 39390l, 588225l, 393900588225l}.forEach::(num)
{
var t := num.DigitalRoot;
Line 1,605 ⟶ 1,919:
console.printLineFormatted("{0} has additive persistence {1} and digital root {2}", num, t.Item1, t.Item2)
}
}</
{{out}}
<pre>
Line 1,616 ⟶ 1,930:
=={{header|Elixir}}==
{{works with|Elixir|1.1}}
<
def root(n, base\\10), do: root(n, base, 0)
Line 1,637 ⟶ 1,951:
{dr, ap} = Digital.root(n, base)
:io.format fmt, [n, ap, dr]
end)</
{{out}}
Line 1,655 ⟶ 1,969:
=={{header|Erlang}}==
Using [[Sum_digits_of_an_integer]].
<
-export( [task/0] ).
Line 1,669 ⟶ 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>
{{out}}
<pre>
Line 1,681 ⟶ 1,995:
=={{header|F_Sharp|F#}}==
This code uses sumDigits from [[Sum_digits_of_an_integer#or_Generically]]
<
//Find the Digital Root of An Integer - Nigel Galloway: February 1st., 2015
//This code will work with any integer type
Line 1,689 ⟶ 2,003:
if s < BASE then (s,p) else root(p+1, s)
root(LanguagePrimitives.GenericZero<_> + 1, N)
</syntaxhighlight>
{{out}}
<pre>
Line 1,709 ⟶ 2,023:
=={{header|Factor}}==
<
IN: rosetta-code.digital-root
Line 1,721 ⟶ 2,035:
printf ;
{ 627615 39390 588225 393900588225 } [ print-root ] each</
{{out}}
<pre>627615 has additive persistence 2 and digital root 9.
Line 1,730 ⟶ 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:
<
: digiroot 0 swap begin (Sdigit) >r 1+ r> dup base @ < until ;</
This will take care of most numbers:
<pre>
Line 1,739 ⟶ 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:
<
: (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 ;</
That one will take care of the last one:
<pre>
Line 1,749 ⟶ 2,063:
=={{header|Fortran}}==
<syntaxhighlight lang="fortran">
program prec
implicit none
Line 1,781 ⟶ 2,095:
write(*,*) 'additive persistance = ', a
end subroutine
</syntaxhighlight>
<pre>
Line 1,799 ⟶ 2,113:
=={{header|FreeBASIC}}==
<
Function digitalRoot(n As UInteger, ByRef ap As Integer, base_ As Integer = 10) As Integer
Line 1,825 ⟶ 2,139:
Next
Print "Press any key to quit"
Sleep</
{{out}}
Line 1,840 ⟶ 2,154:
=={{header|Fōrmulæ}}==
{{FormulaeEntry|page=https://formulae.org/?script=examples/Digital_root}}
'''Solution'''
[[File:Fōrmulæ - Digital root 01.png]]
'''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]].
<
import (
Line 1,916 ⟶ 2,236:
}
}
}</
{{out}}
<pre>
Line 1,938 ⟶ 2,258:
=={{header|Groovy}}==
{{trans|Java}}
<
static int[] calcDigitalRoot(String number, int base) {
BigInteger bi = new BigInteger(number, base)
Line 1,963 ⟶ 2,283:
}
}
}</
{{out}}
<pre>627615 has additive persistence 2 and digital root of 9
Line 1,971 ⟶ 2,291:
=={{header|Haskell}}==
<
import Data.List (unfoldr)
import Data.Tuple (swap)
Line 1,989 ⟶ 2,309:
main = do
putStrLn "in base 10:"
mapM_ (print . ((,) <*> digRoot 10)) [627615, 39390, 588225, 393900588225]</
{{out}}
<pre>
Line 1,999 ⟶ 2,319:
</pre>
<
import Data.Maybe (fromJust)
import Data.List (elemIndex, unfoldr)
Line 2,061 ⟶ 2,381:
, (36, "50YE8N29")
, (36, "37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVN")
]</
{{out}}
<pre>
Line 2,073 ⟶ 2,393:
=={{header|Huginn}}==
<
if ( size( argv_ ) < 2 ) {
throw Exception( "usage: digital-root {NUM}" );
Line 2,088 ⟶ 2,408:
print( "{}\n".format( acc ) );
return ( 0 );
}</
=={{header|Icon}} and {{header|Unicon}}==
The following works in both languages:
<
every m := n := integer(!A) do {
ap := 0
Line 2,104 ⟶ 2,424:
n ? while s +:= move(1)
return s
end</
{{out|Sample run}}
<pre>
Line 2,116 ⟶ 2,436:
=={{header|J}}==
<syntaxhighlight lang="j">digrt=: 10&$: :(|&.<:^:<:)"0
With these functions, the base can be supplied as a left argument (dyadic). When being called monadically, they default to base 10.
Example use:
<syntaxhighlight lang="j"> (,. addps ,. digrt) 627615 39390 588225 393900588225
627615 2 9
39390 2 6
588225 2 3
393900588225 2 9
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>
<syntaxhighlight lang="j"> equals table i. 10
┌──────┬───────────────────┐
│equals│0 1 2 3 4 5 6 7 8 9│
Line 2,148 ⟶ 2,471:
│8 │0 0 0 0 0 0 0 0 1 0│
│9 │1 0 0 0 0 0 0 0 0 1│
└──────┴───────────────────┘</
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.
=={{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>
<
class DigitalRoot
Line 2,196 ⟶ 2,532:
}
}
}</
{{out|Example}}
<pre>java DigitalRoot 627615 39390 588225 393900588225
Line 2,205 ⟶ 2,541:
=={{header|JavaScript}}==
<
/// @return {addpers, digrt}
function digitalRootBase(x,b) {
Line 2,220 ⟶ 2,556:
rootobj.addpers += 1;
return rootobj;
}</
=={{header|jq}}==
Line 2,226 ⟶ 2,562:
digital_root(n) is defined here for decimals and strings representing decimals.
<
def u: if condition then . else (next|u) end;
u;
Line 2,245 ⟶ 2,581:
| "\(.): \($in[.])";
def rjust(n): tostring | (n-length)*" " + .;</
'''Examples''':
<
" i : [DR, P]",
(961038, 923594037444, 670033, 448944221089
Line 2,254 ⟶ 2,590:
),
"",
"digital_root(\"1\" * 100000) => \(digital_root( "1" * 100000))"</
{{out}}
<
i : [DR, P]
Line 2,264 ⟶ 2,600:
448944221089: [1,3]
digital_root("1" * 100000) => [1,2]</
=={{header|Julia}}==
{{works with|Julia|0.6}}
<
if n < 0 || bs < 2 throw(DomainError()) end
ds, pers = n, 0
Line 2,282 ⟶ 2,618:
pers, ds = digitalroot(i)
println(i, " has persistence ", pers, " and digital root ", ds)
end</
{{out}}
Line 2,292 ⟶ 2,628:
=={{header|K}}==
<syntaxhighlight lang="k">
/ print digital root and additive persistence
prt: {`"Digital root = ", x, `"Additive persistence = ",y}
Line 2,299 ⟶ 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>
{{out}}
Line 2,320 ⟶ 2,656:
=={{header|Kotlin}}==
<
fun sumDigits(n: Long): Int = when {
Line 2,355 ⟶ 2,691:
println("${n.toString().padEnd(12)} has additive persistence $ap and digital root of $dr")
}
}</
{{out}}
Line 2,371 ⟶ 2,707:
=={{header|Lua}}==
With function sum_digits from [http://rosettacode.org/wiki/Sum_digits_of_an_integer#Lua]
<
p = 0
while n > 9.5 do
Line 2,383 ⟶ 2,719:
print(digital_root(39390, 10))
print(digital_root(588225, 10))
print(digital_root(393900588225, 10))</
{{out}}
<pre>9 2
Line 2,392 ⟶ 2,728:
=={{header|MAD}}==
<
VECTOR VALUES INP = $I12*$
VECTOR VALUES OUTP = $I12,S1,I12*$
Line 2,414 ⟶ 2,750:
TRANSFER TO RDNUM
END OF CONDITIONAL
END OF PROGRAM</
{{out}}
Line 2,432 ⟶ 2,768:
<!-- codificado por: matthias@lutter.cc -->
Código sacado de https://lutter.cc/malbolge/
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<
root[n_Integer, base_: 10] := If[base == 10, #, BaseForm[#, base]] &[Last[seq[n, base]]]
persistance[n_Integer, base_: 10] := Length[seq[n, base]] - 2;</
{{out}}
<pre> root /@ {627615, 39390, 588225 , 393900, 588225, 670033, 448944221089}
Line 2,908 ⟶ 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}}==
<
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;
Line 2,960 ⟶ 2,906:
ReadChar
END DigitalRoot.</
=={{header|Modula-3}}==
{{trans|Modula-2}}
<syntaxhighlight lang="modula3">MODULE DigitalRoot EXPORTS Main;
IMPORT IO;
FROM Fmt IMPORT F,LongInt;
TYPE
Root = RECORD persistence,R:LONGINT END;
VAR
R:Root;
Arr:ARRAY[0..3] OF LONGINT := ARRAY OF LONGINT{627615L,
39390L,
588225L,
393900588225L};
PROCEDURE DigitalRoot(InRoot,Base:LONGINT):Root =
VAR
r,persistence,Num:LONGINT;
BEGIN
r := ABS(InRoot);
persistence := 0L;
WHILE r >= Base DO
Num := r;
r := 0L;
WHILE Num # 0L DO
r := r + (Num MOD Base);
Num := Num DIV Base;
END;
INC(persistence);
END;
RETURN Root{persistence, r};
END DigitalRoot;
BEGIN
FOR I := FIRST(Arr) TO LAST(Arr) DO
R := DigitalRoot(Arr[I], 10L);
IO.Put(F(LongInt(Arr[I]) &
" has additive persistence %s and digital root of %s\n",
LongInt(R.persistence),
LongInt(R.R)));
END;
END DigitalRoot.</syntaxhighlight>
=={{header|Nanoquery}}==
{{trans|Python}}
<
ap = 0
n = +(int(n))
Line 2,986 ⟶ 2,977:
println format("%12d has additive persistence %2d and digital root %d.", n, aproot[0], aproot[1])
end
end</
{{out}}
Line 2,996 ⟶ 2,987:
=={{header|NetRexx}}==
<
* Test digroot
**********************************************************************/
Line 3,029 ⟶ 3,020:
n=s /* the 'new' number */
End
return n p /* return root and persistence */</
{{out}}
<pre>
Line 3,042 ⟶ 3,033:
=={{header|Nim}}==
<
proc droot(n: int64): auto =
Line 3,055 ⟶ 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</
{{out}}
<pre> 627615 has additive persistence 2 and digital root of 9
Line 3,061 ⟶ 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 3,066 ⟶ 3,082:
Using result of sum digit task :
<
: digitalRoot(n, base)
0 while(n 9 >) [ 1 + sumDigits(n, base) ->n ] n swap Pair new ;</
{{out}}
Line 3,078 ⟶ 3,094:
=={{header|Ol}}==
<
(define (digital-root num)
(if (less? num 10)
Line 3,091 ⟶ 3,107:
(print (digital-root 588225))
(print (digital-root 393900588225))
</syntaxhighlight>
{{Out}}
<pre>
Line 3,101 ⟶ 3,117:
=={{header|PARI/GP}}==
<
additivePersistence(n)=my(s); while(n>9, s++; n=dsum(n)); s
digitalRoot(n)=if(n, (n-1)%9+1, 0)</
=={{header|Pascal}}==
{{works with|Free Pascal|2.6.2}}
<
{$mode objfpc}{$H+}
Line 3,176 ⟶ 3,192:
ReadLn;
End.</
{{out}}
<pre>--- Examples in 10-Base ---
Line 3,190 ⟶ 3,206:
=={{header|Perl}}==
<
use strict;
use warnings;
Line 3,240 ⟶ 3,256:
print "\n";
}
}</
{{out}}
<pre>
Line 3,287 ⟶ 3,303:
=={{header|Phix}}==
<!--<
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
Line 3,310 ⟶ 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>
<!--</
{{out}}
<pre>
Line 3,318 ⟶ 3,334:
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}}==
<syntaxhighlight lang="picat">go =>
foreach(N in [627615,39390,588225,393900588225,
58142718981673030403681039458302204471300738980834668522257090844071443085937])
[Sum,Persistence] = digital_root(N),
printf("%w har addititive persistence %d and digital root of %d\n", N,Persistence,Sum)
end,
nl.
%
% (Reduced) digit sum (digital root) of a number
%
digital_root(N) = [Sum,Persistence], integer(N) =>
Sum = N,
Persistence = 0,
while(Sum > 9)
Sum := sum([I.to_integer() : I in Sum.to_string()]),
Persistence := Persistence + 1
end.</syntaxhighlight>
{{out}}
<pre>627615 har addititive persistence 2 and digital root of 9
39390 har addititive persistence 2 and digital root of 6
588225 har addititive persistence 2 and digital root of 3
393900588225 har addititive persistence 2 and digital root of 9
58142718981673030403681039458302204471300738980834668522257090844071443085937 har addititive persistence 3 and digital root of 4</pre>
=={{header|PicoLisp}}==
<
(for ((A . I) N T (sum format (chop I)))
(T (> 10 I)
(prinl N " has additive persistance " (dec A) " and digital root of " I ";") ) ) )</
{{out}}
<pre>627615 has additive persistance 2 and digital root of 9;
Line 3,331 ⟶ 3,415:
=={{header|PL/I}}==
<
/* REXX ***************************************************************
* Test digroot
Line 3,389 ⟶ 3,473:
Return(res);
End;
End;</
{{out}}
<pre>
Line 3,399 ⟶ 3,483:
</pre>
Alternative:
<
declare 1 pict union,
2 x picture '9999999999999',
Line 3,413 ⟶ 3,497:
end;
end digital;</
Results:
<pre>
Line 3,426 ⟶ 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.
<
/* BDOS SYSTEM CALL */
Line 3,527 ⟶ 3,611:
CALL PRINT$DR$ANDPERSISTENCE( 3939, 0058, 8225 );
EOF</
{{out}}
<pre>
Line 3,537 ⟶ 3,621:
=={{header|Potion}}==
<
dr = x string # Digital Root.
ap = 0 # Additive Persistence.
Line 3,553 ⟶ 3,637:
digital(39390)
digital(588225)
digital(393900588225)</
=={{header|PowerShell}}==
Uses the recursive function from the 'Sum Digits of an Integer' task.
<
{
function Get-Digitalsum ($n)
Line 3,575 ⟶ 3,659:
}
$DigitalRoot
}</
Command:
<pre>
Line 3,587 ⟶ 3,671:
</pre>
===Alternative Method===
<
param($n)
$ap = 0
Line 3,595 ⟶ 3,679:
AdditivePersistence = $ap
}
}</
Command:
<pre>
Line 3,610 ⟶ 3,694:
=={{header|Prolog}}==
{{works with|SWI Prolog}}
<
digit_sum(N, Base, Sum, 0).
Line 3,642 ⟶ 3,726:
test_digital_root(588225, 10),
test_digital_root(393900588225, 10),
test_digital_root(685943443231217865409, 10).</
{{out}}
Line 3,654 ⟶ 3,738:
=={{header|PureBasic}}==
<
; Procedure.q DigitalRoot(N.q) apparently will do
; i must have missed something because it seems too simple
Line 3,702 ⟶ 3,786:
; cw(DigitalRootandPersistance(N))
Debug DigitalRootandPersistance(N)
Next</
{{out}}
<pre>
Line 3,713 ⟶ 3,797:
=={{header|Python}}==
===Procedural===
<
ap = 0
n = abs(int(n))
Line 3,725 ⟶ 3,809:
persistance, root = digital_root(n)
print("%12i has additive persistance %2i and digital root %i."
% (n, persistance, root))</
{{out}}
Line 3,742 ⟶ 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''':
<
Line 3,805 ⟶ 3,889:
if __name__ == '__main__':
main()</
{{Out}}
<pre>Integer -> (additive persistence, digital root):
Line 3,816 ⟶ 3,900:
=={{header|Quackery}}==
<
[ base share /mod
rot + swap
Line 3,838 ⟶ 3,922:
39390 task
588225 task
393900588225 task</
'''Output:'''
Line 3,850 ⟶ 3,934:
=={{header|R}}==
The code prints digital root and persistence seperately
<
digital_root=function(n){
x=sum(as.numeric(unlist(strsplit(as.character(n),""))))
Line 3,862 ⟶ 3,946:
return(k)
}
print("Given number has additive persistence",y)</
=={{header|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,889 ⟶ 3,973:
(check-equal? a ap)
(check-equal? d dr)
(printf ":~a has additive persistence ~a and digital root of ~a;~%" n a d)))))</
{{out}}
<pre>627615 has additive persistence 2 and digital root of 9
Line 3,898 ⟶ 3,982:
=={{header|Raku}}==
(formerly Perl 6)
<syntaxhighlight lang="raku"
my $root = $r.base($base);
my $persistence = 0;
while $root.chars > 1 {
$root =
$persistence++;
}
Line 3,918 ⟶ 4,002:
for @testnums -> $n {
printf ":$b\<%s>\ndigital root %s, persistence %s\n\n",
$n.base($b),
}
}</
{{out}}
<pre>:10<627615>
Line 3,981 ⟶ 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>
<syntaxhighlight lang="raku"
my &sum = {
return .[*-1], .elems-1
given $r.base($base), &sum
}</
Output same as above.
=={{header|REXX}}==
===version 1===
<
* Test digroot
**********************************************************************/
Line 4,017 ⟶ 4,102:
n=s /* the 'new' number */
End
return n p /* return root and persistence */</
===version 2===
<
say 'digital
say " root persistence" center('number',77) /* " " 2nd " " " " */
say "═══════ ═══════════" left('', 77, "═") /* " " 3rd " " " " */
say "═══════ ═══════════" left('', 77, "═") /*display the foot separator. */
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
digRoot: procedure;
x= $;
return center(x, 7)
{{out|output|text= when using the internal default inputs:}}
<pre>
digital additive
root persistence number
═══════ ═══════════ ═════════════════════════════════════════════════════════════════════════════
Line 4,050 ⟶ 4,134:
9 2 393900588225
8 3 89999999999999999999999999999999999999999999999999999999999999999999999999999
═══════ ═══════════ ═════════════════════════════════════════════════════════════════════════════
</pre>
===version 3===
This subroutine version can also handle numbers with signs, blanks, commas, and/or decimal points.
<syntaxhighlight 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 " " " " */
say "═══════ ═══════════" left('', 77, "═") /* " " 3rd " " " " */
say digRoot( 627615)
say digRoot( 39390)
say digRoot( 588225)
say digRoot( 393900588225)
say digRoot(89999999999999999999999999999999999999999999999999999999999999999999999999999)
say "═══════ ═══════════" left('', 77, "═") /*display the foot separator. */
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
digRoot: procedure; parse arg x 1 ox;
if datatype(?
end
x= $;
return center(x,7)
{{out|output|text= is identical to the 2<sup>nd</sup> REXX version.}} <br><br>
=={{header|Ring}}==
<
c = 0
see "Digital root of 627615 is " + digitRoot(627615, 10) + " persistance is " + c + nl
Line 4,094 ⟶ 4,185:
end
return s
</syntaxhighlight>
=={{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}}==
<
def digroot_persistence(base=10)
num = self.to_i(base)
Line 4,120 ⟶ 4,230:
["50YE8N29", 36]].each do |(str, base)|
puts format % [str, base, *str.digroot_persistence(base)]
end</
{{out}}
<pre>
Line 4,137 ⟶ 4,247:
=={{header|Run BASIC}}==
<
print "Digital root of 39390 is "; digitRoot$(39390, 10)
print "Digital root of 588225 is "; digitRoot$(588225, 10)
Line 4,159 ⟶ 4,269:
wend
digSum = s
end function</
{{out}}
<pre>Digital root of 627615 is 9 persistance is 2
Line 4,168 ⟶ 4,278:
=={{header|Rust}}==
<
let mut sum = 0u64;
while n > 0 {
Line 4,210 ⟶ 4,320:
pers);
}
}</
{{out}}
<pre>
Line 4,222 ⟶ 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}}==
<
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,236 ⟶ 4,391:
}
var (s, c)=digitalRoot(0x7e0, 16)
println("%x has additive persistance %d and digital root of %d".format(0x7e0,c,s))</
{{out}}
<pre>627615 has additive persistance 2 and digital root of 9
Line 4,243 ⟶ 4,398:
393900588225 has additive persistance 2 and digital root of 9
7e0 has additive persistance 2 and digital root of 6</pre>
=={{header|Scheme}}==
{{works with|Chez Scheme}}
<syntaxhighlight lang="scheme">; Convert an integer into a list of its digits.
(define integer->list
(lambda (integer)
(let loop ((list '()) (int integer))
(if (< int 10)
(cons int list)
(loop (cons (remainder int 10) list) (quotient int 10))))))
; Return the sum of the digits of an integer.
(define integer-sum-digits
(lambda (integer)
(fold-left + 0 (integer->list integer))))
; Compute the digital root (additive) and additive persistence of an integer.
; Return as a cons of (adr . ap).
(define adr-ap
(lambda (integer)
(let loop ((int integer) (cnt 0))
(if (< int 10)
(cons int cnt)
(loop (integer-sum-digits int) (1+ cnt))))))
; Emit a table of integer, digital root (additive), and additive persistence
; for the example integers given.
(printf "~13@a ~6@a ~6@a~%" "Integer" "Root" "Pers.")
(let rowloop ((intlist '(627615 39390 588225 393900588225 0 1 68010887038)))
(when (pair? intlist)
(let* ((int (car intlist))
(aa (adr-ap int)))
(printf "~13@a ~6@a ~6@a~%" int (car aa) (cdr aa))
(rowloop (cdr intlist)))))</syntaxhighlight>
{{out}}
<pre> Integer Root Pers.
627615 9 2
39390 6 2
588225 3 2
393900588225 9 2
0 0 0
1 1 0
68010887038 4 3</pre>
=={{header|Seed7}}==
<
include "bigint.s7i";
Line 4,274 ⟶ 4,475:
writeln(num <& " has additive persistence " <& persistence <& " and digital root of " <& root);
end for;
end func;</
{{out}}
<pre>
Line 4,285 ⟶ 4,486:
=={{header|Sidef}}==
{{trans|Perl}}
<
var root = r.base(base)
var persistence = 0
Line 4,309 ⟶ 4,510:
}
print "\n"
}</
{{out}}
<pre>
Line 4,357 ⟶ 4,558:
=={{header|Smalltalk}}==
{{works with|Smalltalk/X}}
<
[:nr :arIn |
r := (nr printString asArray collect:#digitValue) sum.
Line 4,373 ⟶ 4,574:
Transcript showCR:'%1 has digitalRoot %3 and Additive Resistance %2'
withArguments:{nr},(digitalRoot value:nr value:0)
]</
{{out}}
<pre>39390 has digitalRoot 6 and Additive Resistance 2
Line 4,383 ⟶ 4,584:
=={{header|SmileBASIC}}==
<
AP=0
DR=N
Line 4,395 ⟶ 4,596:
DR=NEWDR
WEND
END</
=={{header|Tcl}}==
<
proc digitalroot num {
for {set p 0} {[string length $num] > 1} {incr p} {
Line 4,409 ⟶ 4,610:
lassign [digitalroot $n] p r
puts [format "$n has additive persistence $p and digital root of $r"]
}</
{{out}}
<pre>
Line 4,419 ⟶ 4,620:
=={{header|TI-83 BASIC}}==
<
:1→X
:Input ">",Str1
Line 4,439 ⟶ 4,640:
:ClrHome
:Disp Str2,"DIGITAL ROOT",expr(Str1),"ADDITIVE","PERSISTENCE",X
:Pause</
{{out}}
<pre>627615
Line 4,456 ⟶ 4,657:
DIGITAL ROOT 9
ADDITIVE PERSISTENCE 2</pre>
== {{header|TypeScript}} ==
{{trans|ASIC}}
<syntaxhighlight lang="javascript">// Digital root
function rootAndPers(n: number, bas: number): [number, number] {
var pers = 0;
while (n >= bas)
{
var s = 0;
do
{
s += n % bas;
n = Math.floor(n / bas);
} while (n > 0);
pers++;
n = s;
}
return [n, pers];
}
for (var a of [1, 14, 267, 8128, 39390, 588225, 627615]) {
var rp = rootAndPers(a, 10);
console.log(a.toString().padStart(7, ' ') +
rp[1].toString().padStart(6, ' ') + rp[0].toString().padStart(6, ' '));
}
</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|uBasic/4tH}}==
{{trans|BBC Basic}}
<syntaxhighlight lang="text">PRINT "Digital root of 627615 is "; FUNC(_FNdigitalroot(627615, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"
Line 4,491 ⟶ 4,729:
a@ = c@
Loop
Return (d@)</
{{Out}}
<pre>Digital root of 627615 is 9 (additive persistence 2)
Line 4,501 ⟶ 4,739:
=={{header|UNIX Shell}}==
<
numbers=(627615 39390 588225 393900588225 55)
Line 4,515 ⟶ 4,753:
echo -e "${number} has additive persistence ${iterations} and digital root ${root}"
unset iterations
done | column -t</
{{ Out }}
<pre>627615 has additive persistence 2 and digital root 9
Line 4,524 ⟶ 4,762:
=={{header|VBA}}==
<
Private Sub digital_root(n As Variant)
Dim s As String, t() As Integer
Line 4,548 ⟶ 4,786:
digital_root 588225
digital_root 393900588225#
End Sub</
<pre> 627615 has additive persistence 2 and digital root of 9;
39390 has additive persistence 2 and digital root of 6;
Line 4,555 ⟶ 4,793:
=={{header|VBScript}}==
<
ap = 0
Do Until Len(n) = 1
Line 4,569 ⟶ 4,807:
End Function
WScript.StdOut.Write digital_root(WScript.Arguments(0))</
{{Out}}
Line 4,590 ⟶ 4,828:
=={{header|Visual Basic .NET}}==
{{trans|C#}}
<
Function DigitalRoot(num As Long) As Tuple(Of Integer, Integer)
Line 4,609 ⟶ 4,847:
End Sub
End Module</
{{out}}
<pre>627615 has additive persistence 2 and digital root 9
Line 4,615 ⟶ 4,853:
588225 has additive persistence 2 and digital root 3
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 {
mut s := 0
mut i := ii
b64 := u64(base)
for ; i > 0; i /= b64 {
s += int(i % b64)
}
return s
}
fn digital_root(n u64, base int) (int, int) {
mut persistence := 0
mut root := int(n)
for x := n; x >= u64(base); x = u64(root) {
root = sum(x, base)
persistence++
}
return persistence, root
}
// Normally the below would be moved to a *_test.go file and
// use the testing package to be runnable as a regular test.
struct Test{
n string
base int
persistence int
root int
}
const test_cases = [
Test{"627615", 10, 2, 9},
Test{"39390", 10, 2, 6},
Test{"588225", 10, 2, 3},
Test{"393900588225", 10, 2, 9},
Test{"1", 10, 0, 1},
Test{"11", 10, 1, 2},
Test{"e", 16, 0, 0xe},
Test{"87", 16, 1, 0xf},
// From Applesoft BASIC example:
Test{"DigitalRoot", 30, 2, 26}, // 26 is Q base 30
// From C++ example:
Test{"448944221089", 10, 3, 1},
Test{"7e0", 16, 2, 0x6},
Test{"14e344", 16, 2, 0xf},
Test{"d60141", 16, 2, 0xa},
Test{"12343210", 16, 2, 0x1},
// From the D example:
Test{"1101122201121110011000000", 3, 3, 1},
]
fn main() {
for tc in test_cases {
n, err := strconv.common_parse_uint2(tc.n, tc.base, 64)
if err != 0 {
panic('ERROR')
}
p, r := digital_root(n, tc.base)
println("${tc.n:12} (base ${tc.base:2}) has additive persistence $p and digital root ${strconv.format_int(i64(r), tc.base)}",)
if p != tc.persistence || r != tc.root {
panic("bad result: $tc $p $r")
}
}
}</syntaxhighlight>
{{out}}
<pre>
627615 (base 10) has additive persistence 2 and digital root 9
39390 (base 10) has additive persistence 2 and digital root 6
588225 (base 10) has additive persistence 2 and digital root 3
393900588225 (base 10) has additive persistence 2 and digital root 9
1 (base 10) has additive persistence 0 and digital root 1
11 (base 10) has additive persistence 1 and digital root 2
e (base 16) has additive persistence 0 and digital root e
87 (base 16) has additive persistence 1 and digital root f
DigitalRoot (base 30) has additive persistence 2 and digital root q
448944221089 (base 10) has additive persistence 3 and digital root 1
7e0 (base 16) has additive persistence 2 and digital root 6
14e344 (base 16) has additive persistence 2 and digital root f
d60141 (base 16) has additive persistence 2 and digital root a
12343210 (base 16) has additive persistence 2 and digital root 1
1101122201121110011000000 (base 3) has additive persistence 3 and digital root 1
</pre>
=={{header|Wortel}}==
<
sumDigits ^(@sum @arr)
drootl &\@rangef [. sumDigits ^(\~>1 #@arr)]
Line 4,629 ⟶ 4,955:
&n !console.log "{n}: {!droot n} {!apers n} {@str !drootl n}"
]
}</
{{out}}
<pre>[number]: [digital root] [additive persistence] [intermediate sums]
Line 4,640 ⟶ 4,966:
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
<
var sumDigits = Fn.new { |n|
Line 4,669 ⟶ 4,995:
var ap = res[1]
Fmt.print("$,15d has additive persistence $d and digital root of $d", n, ap, dr)
}</
{{out}}
Line 4,687 ⟶ 5,013:
precision needed.
<
func DRoot(N, B, P); \Return digital root and persistance P
Line 4,712 ⟶ 5,038:
IntOut(0, Pers); ChOut(0, ^ ); IntOut(0, Root); CrLf(0);
];
]</
{{out}}
<pre>
Line 4,722 ⟶ 5,048:
=={{header|zkl}}==
<
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)) }</
<
droot(39390)
droot(588225)
droot(393900588225)
droot(7,2)
droot(0x7e0,16)</
{{out}}
<pre>
Line 4,742 ⟶ 5,068:
=={{header|zonnon}}==
<
module Main;
type
Line 4,783 ⟶ 5,109:
write(max(integer{64}):22,":> ");DigitalRoot(max(integer{64})).Writeln;
end Main.
</syntaxhighlight>
{{Out}}
<pre>
Line 4,795 ⟶ 5,121:
=={{header|ZX Spectrum Basic}}==
{{trans|Run BASIC}}
<
20 READ j: LET b=10
30 FOR i=1 TO j
Line 4,812 ⟶ 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</
|