Digital root

Digital root is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

ref1: http://en.wikipedia.org/wiki/Digital_root

The task is to calculate the additive persistance and the digital root of a number. e.g.

627615 has additive persistance __ and digital root of __;

39390 has additive persistance __ and digital root of __;

588225 has additive persistance __ and digital root of __;

393900588225 has additive persistance __ and digital root of __;

Ref 1 identifies the relationship of this task to casting out nines. See: http://rosettacode.org/wiki/Casting_out_nines for this wiki's use of this procedure.

BASIC

Works with: QBasic

This example is in need of improvement.

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.

<lang qbasic>DECLARE SUB digitalRoot (what AS LONG)

'test inputs: digitalRoot 627615 digitalRoot 39390 digitalRoot 588225

SUB digitalRoot (what AS LONG)

   DIM w AS LONG, t AS LONG, c AS INTEGER

   w = ABS(what)
   IF w > 10 THEN
       DO
           c = c + 1
           WHILE w
               t = t + (w MOD (10))
               w = w \ 10
           WEND
           w = t
           t = 0
       LOOP WHILE w > 9
   END IF
   PRINT what; ": additive persistance "; c; ", digital root "; w

END SUB</lang>

Output:

627615 : additive persistance  2 , digital root  9
39390 : additive persistance  2 , digital root  6
588225 : additive persistance  2 , digital root  3

J

<lang J>digrot=: +/@(#.inv~&10)^:_ addper=: _1 + [: # +/@(#.inv~&10)^:a:</lang>

Example use:

<lang J> (, addper, digrot)&> 627615 39390 588225 393900588225

     627615 2 9
      39390 2 6
     588225 2 3

393900588225 2 9</lang>

Tcl

<lang tcl>package require Tcl 8.5 proc digitalroot num {

   for {set p 0} {[string length $num] > 1} {incr p} {

set num [::tcl::mathop::+ {*}[split $num ""]]

   }
   list $p $num

}

foreach n {627615 39390 588225 393900588225} {

   lassign [digitalroot $n] p r
   puts [format "$n has additive persistence $p and digital root of $r"]

}</lang>

Output:

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