Digital root/Multiplicative digital root: Difference between revisions

Content added Content deleted

Inline

Revision as of 23:11, 3 May 2014

The multiplicative digital root (MDR) and multiplicative persistence (MP) of a number, $n$ , is calculated rather like the Digital root except digits are multiplied instead of being added:

Set $m$ to $n$ and $i$ to $0$ .
While $m$ $m$ has more than one digit:
- Find a replacement $m$ as the multiplication of the digits of the current value of $m$ .
- Increment $i$ .
Return $i$ (= MP) and $m$ (= MDR)

Task

Tabulate the MP and MDR of the numbers 123321, 7739, 893, 899998
Tabulate MDR versus the first five numbers having that MDR, something like:

MDR: [n0..n4]
===  ========
  0: [0, 10, 20, 25, 30]
  1: [1, 11, 111, 1111, 11111]
  2: [2, 12, 21, 26, 34]
  3: [3, 13, 31, 113, 131]
  4: [4, 14, 22, 27, 39]
  5: [5, 15, 35, 51, 53]
  6: [6, 16, 23, 28, 32]
  7: [7, 17, 71, 117, 171]
  8: [8, 18, 24, 29, 36]
  9: [9, 19, 33, 91, 119]

Show all output on this page.

References

Multiplicative Digital Root on Wolfram Mathworld.
Multiplicative digital root on The On-Line Encyclopedia of Integer Sequences.

Bracmat

<lang bracmat>( & ( MP/MDR

 =   prod L n
   .   ( prod
       =   d
         .   @(!arg:%@?d ?arg)&!d*prod$!arg
           | 1
       )
     & !arg:?L
     &   whl
       ' ( @(!arg:? [>1)
         & (prod$!arg:?arg) !L:?L
         )
     & !L:? [?n
     & (!n+-1.!arg)
 )

& ( test

 =   n
   .     !arg:%?n ?arg
       & out$(!n "\t:" MP/MDR$!n)
       & test$!arg
     | 
 )

& test$(123321 7739 893 899998) & 0:?i & 1:?collecting:?done & whl

 ' ( !i+1:?i
   & MP/MDR$!i:(?MP.?MDR)
   & ( !done:?*(!MDR.)^((?.)+?)*?
     |   (!MDR.)^(!i.)*!collecting:?collecting
       & (   !collecting:?A*(!MDR.)^(?is+[5)*?Z
           & !A*!Z:?collecting
           & (!MDR.)^!is*!done:?done
         | 
         )
     )
   & !collecting:~1
   )

& whl

 ' ( !done:(?MDR.)^?is*?done
   & put$(!MDR ":")
   & whl'(!is:(?i.)+?is&put$(!i " "))
   & put$\n
   )

);</lang> Output:

123321  : (3.8)
7739    : (3.8)
893     : (3.2)
899998  : (2.0)
0 :10  20  25  30  40
1 :1  11  111  1111  11111
2 :2  12  21  26  34
3 :3  13  31  113  131
4 :4  14  22  27  39
5 :5  15  35  51  53
6 :6  16  23  28  32
7 :7  17  71  117  171
8 :8  18  24  29  36
9 :9  19  33  91  119

Note that in the function mdrNums we don't know in advance how many numbers we'll need to examine to find the first 5 associated with all the MDRs. Using a lazy array to accumulate these numbers allows us to keep the function simple. <lang haskell>import Control.Arrow import Data.Array import Data.LazyArray import Data.List (unfoldr) import Data.Tuple import Text.Printf

-- The multiplicative persistence (MP) and multiplicative digital root (MDR) of -- the argument. mpmdr :: Integer -> (Int, Integer) mpmdr = (length *** head) . span (> 9) . iterate (product . digits)

-- Pairs (mdr, ns) where mdr is a multiplicative digital root and ns are the -- first k numbers having that root. mdrNums :: Int -> [(Integer, [Integer])] mdrNums k = assocs $ lArrayMap (take k) (0,9) [(snd $ mpmdr n, n) | n <- [0..]]

digits :: Integral t => t -> [t] digits 0 = [0] digits n = unfoldr step n

 where step k = if k == 0 then Nothing else Just (swap $ quotRem k 10)

printMpMdrs :: [Integer] -> IO () printMpMdrs ns = do

 putStrLn "Number MP MDR"
 putStrLn "====== == ==="
 sequence_ [printf "%6d %2d %2d\n" n p r | n <- ns, let (p,r) = mpmdr n]

printMdrNums:: Int -> IO () printMdrNums k = do

 putStrLn "MDR Numbers"
 putStrLn "=== ======="
 let showNums = unwords . map show
 sequence_ [printf "%2d  %s\n" mdr $ showNums ns | (mdr,ns) <- mdrNums k]

main :: IO () main = do

 printMpMdrs [123321, 7739, 893, 899998]
 putStrLn ""
 printMdrNums 5</lang>

Output:

Note that the values in the first column of the table are MDRs, as shown in the task's sample output, not MP as incorrectly stated in the task statement and column header.

Number MP MDR
====== == ===
123321  3  8
  7739  3  8
   893  3  2
899998  2  0

MDR Numbers
=== =======
 0  0 10 20 25 30
 1  1 11 111 1111 11111
 2  2 12 21 26 34
 3  3 13 31 113 131
 4  4 14 22 27 39
 5  5 15 35 51 53
 6  6 16 23 28 32
 7  7 17 71 117 171
 8  8 18 24 29 36
 9  9 19 33 91 119

Icon and Unicon

Works in both languages: <lang unicon>procedure main(A)

   write(right("n",8)," ",right("MP",8),right("MDR",5))
   every r := mdr(n := 123321|7739|893|899998) do
       write(right(n,8),":",right(r[1],8),right(r[2],5))
   write()
   write(right("MDR",5),"  ","[n0..n4]")
   every m := 0 to 9 do {
       writes(right(m,5),": [")
       every writes(right((m = mdr(n := seq(m))[2],.n)\5,6))
       write("]")
       }

end

procedure mdr(m)

   i := 0
   while (.m > 10, m := multd(m), i+:=1)
   return [i,m]

end

procedure multd(m)

   c := 1
   while m > 0 do c *:= 1(m%10, m/:=10)
   return c

end</lang>

Output:

->drmdr
       n       MP  MDR
  123321:       3    8
    7739:       3    8
     893:       3    2
  899998:       2    0

  MDR  [n0..n4]
    0: [     0    20    30    40    45]
    1: [     1    11   111  1111 11111]
    2: [     2    12    21    26    34]
    3: [     3    13    31   113   131]
    4: [     4    14    22    27    39]
    5: [     5    15    35    51    53]
    6: [     6    16    23    28    32]
    7: [     7    17    71   117   171]
    8: [     8    18    24    29    36]
    9: [     9    19    33    91   119]
->

J

First, we need something to split a number into digits:

Second, we need to find their product:

Then we use this inductively until it converges:

MP is one less than the length of this list, and MDR is the last element of this list:

<lang J> (<:@#,{:) */@(10&#.inv)^:a: 123321 3 8

  (<:@#,{:) */@(10&#.inv)^:a: 7739

3 8

  (<:@#,{:) */@(10&#.inv)^:a: 893

3 2

  (<:@#,{:) */@(10&#.inv)^:a: 899998

2 0</lang>

For the table, we don't need that whole list, we only need the final value. Then use these values to classify the original argument (taking the first five from each group):

Note that since the first 10 non-negative integers are single digit values, the first column here doubles as a label (representing the corresponding multiplicative digital root).

PL/I

<lang PL/I>multiple: procedure options (main); /* 29 April 2014 */

  declare n fixed binary (31);

find_mdr: procedure;

  declare (mdr, mp, p) fixed binary (31);

  mdr = n;
  do mp = 1 by 1 until (p <= 9);
     p = 1;
     do until (mdr = 0); /* Form product of the digits in mdr. */
        p = mod(mdr, 10) * p;
        mdr= mdr/10;
     end;
     mdr = p;
  end;
  put skip data (n, mdr, mp);

end find_mdr;

  do n = 123321, 7739, 893, 899998;
     call find_mdr;
  end;

end multiple;</lang> Output:

N=        123321        MDR=             8      MP=             3;
N=          7739        MDR=             8      MP=             3;
N=           893        MDR=             2      MP=             3;
N=        899998        MDR=             0      MP=             2;

Python

Python: Inspired by the solution to the Digital root task

<lang python>try:

   from functools import reduce

except:

   pass

def mdroot(n):

   'Multiplicative digital root'
   mdr = [n]
   while mdr[-1] > 9:
       mdr.append(reduce(int.__mul__, (int(dig) for dig in str(mdr[-1])), 1))
   return len(mdr) - 1, mdr[-1]

if __name__ == '__main__':

   print('Number: (MP, MDR)\n======  =========')
   for n in (123321, 7739, 893, 899998):
       print('%6i: %r' % (n, mdroot(n)))
       
   table, n = {i: [] for i in range(10)}, 0
   while min(len(row) for row in table.values()) < 5:
       mpersistence, mdr = mdroot(n)
       table[mdr].append(n)
       n += 1
   print('\nMP: [n0..n4]\n==  ========')
   for mp, val in sorted(table.items()):
       print('%2i: %r' % (mp, val[:5]))</lang>

Output:

Number: (MP, MDR)
======  =========
123321: (3, 8)
  7739: (3, 8)
   893: (3, 2)
899998: (2, 0)

MP: [n0..n4]
==  ========
 0: [0, 10, 20, 25, 30]
 1: [1, 11, 111, 1111, 11111]
 2: [2, 12, 21, 26, 34]
 3: [3, 13, 31, 113, 131]
 4: [4, 14, 22, 27, 39]
 5: [5, 15, 35, 51, 53]
 6: [6, 16, 23, 28, 32]
 7: [7, 17, 71, 117, 171]
 8: [8, 18, 24, 29, 36]
 9: [9, 19, 33, 91, 119]

Python: Inspired by the more efficient version of D.

Substitute the following function to run twice as fast when calculating mdroot(n) with n in range(1000000). <lang python>def mdroot(n):

   count, mdr = 0, n 
   while mdr > 9:
       m, digitsMul = mdr, 1
       while m:
           m, md = divmod(m, 10)
           digitsMul *= md
       mdr = digitsMul
       count += 1
   return count, mdr</lang>

Output:

(Exactly the same as before).

Racket

<lang racket>#lang racket (define (digital-product n)

 (define (inr-d-p m rv)
   (cond
     [(zero? m) rv]
     [else (define-values (q r) (quotient/remainder m 10))
           (if (zero? r) 0 (inr-d-p q (* rv r)))])) ; lazy on zero
 (inr-d-p n 1))

(define (mdr/mp n)

 (define (inr-mdr/mp m i)
   (if (< m 10) (values m i) (inr-mdr/mp (digital-product m) (add1 i))))
 (inr-mdr/mp n 0))

(printf "Number\tMDR\tmp~%======\t===\t==~%") (for ((n (in-list '(123321 7739 893 899998))))

 (define-values (mdr mp) (mdr/mp n))
 (printf "~a\t~a\t~a~%" n mdr mp))

(printf "~%MDR\t[n0..n4]~%===\t========~%") (for ((MDR (in-range 10)))

 (define (has-mdr? n) (define-values (mdr mp) (mdr/mp n)) (= mdr MDR))
 (printf "~a\t~a~%" MDR (for/list ((_ 5) (n (sequence-filter has-mdr? (in-naturals)))) n)))</lang>

Output:

Number	MDR	mp
======	===	==
123321	8	3
7739	8	3
893	2	3
899998	0	2

MDR	[n0..n4]
===	========
0	(0 10 20 25 30)
1	(1 11 111 1111 11111)
2	(2 12 21 26 34)
3	(3 13 31 113 131)
4	(4 14 22 27 39)
5	(5 15 35 51 53)
6	(6 16 23 28 32)
7	(7 17 71 117 171)
8	(8 18 24 29 36)
9	(9 19 33 91 119)

REXX

idomatic version

<lang rexx>/*REXX pgm finds persistence and multiplicative digital root of some #'s*/ numeric digits 100 /*increase the number of digits. */ parse arg x /*get some numbers from the C.L. */ if x= then x=123321 7739 893 899998 /*use defaults if none specified.*/ say center('number',8) ' persistence multiplicative digital root' say copies('─' ,8) ' ─────────── ───────────────────────────'

                                      /* [↑]  title  and  separator.   */
    do j=1  for words(x); n=word(x,j) /*process each number in the list*/
    parse value mdr(n)  with  mp mdr  /*obtain the persistence and MDR.*/
    say right(n,8) center(mp,13) center(mdr,30)   /*display #, mp, mdr.*/
    end   /*j*/                       /* [↑] show MP and MDR for each #*/

say; target=5 say 'MDR first ' target " numbers that have a matching MDR" say '═══ ═══════════════════════════════════════════════════'

    do k=0  for 10;  hits=0;  _=      /*show #'s that have an MDR of K.*/
      do m=0  until hits==target      /*find five #'s with an MDR of K.*/
      if word(mdr(m),2)\==k  then iterate  /*is the MDR want's wanted? */
      hits=hits+1;  _=space(_ m',')   /*yes, we got a hit, add to list.*/
      end   /*m*/                     /* [↑]  built a list of MDRs = k */
    say " "k':     ['strip(_,,',')"]" /*display the  K  (mdr) and list.*/
    end     /*k*/                     /* [↑]  done with the K mdr list.*/

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────MDR subroutine──────────────────────*/ mdr: procedure; parse arg y; y=abs(y) /*get the number and find the MDR*/

  do p=1  until  y<10                 /*find multiplicative digRoot (Y)*/
  parse var y 1 r 2;  do k=2  to length(y);  r=r*substr(y,k,1); end;  y=r
  end   /*p*/                         /*wash, rinse, repeat ···        */

return p r /*return the persistence and MDR.*/</lang> output

 number   persistence   multiplicative digital root
────────  ───────────   ───────────────────────────
  123321       3                     8
    7739       3                     8
     893       3                     2
  899998       2                     0

MDR        first  5  numbers that have a matching MDR
═══   ═══════════════════════════════════════════════════
 0:     [0, 10, 20, 25, 30]
 1:     [1, 11, 111, 1111, 11111]
 2:     [2, 12, 21, 26, 34]
 3:     [3, 13, 31, 113, 131]
 4:     [4, 14, 22, 27, 39]
 5:     [5, 15, 35, 51, 53]
 6:     [6, 16, 23, 28, 32]
 7:     [7, 17, 71, 117, 171]
 8:     [8, 18, 24, 29, 36]
 9:     [9, 19, 33, 91, 119]

untra-fast version

<lang rexx>/*REXX pgm finds persistence and multiplicative digital root of some #'s*/ numeric digits 100 /*increase the number of digits. */ parse arg x; if x= then x=123321 7739 893 899998 /*use the defaults?*/ say center('number',8) ' persistence multiplicative digital root' say copies('─' ,8) ' ─────────── ───────────────────────────'

                                      /* [↑]  title  and  separator.   */
    do j=1  for words(x); n=word(x,j) /*process each number in the list*/
    parse value mdr(n)  with  mp mdr  /*obtain the persistence and MDR.*/
    say right(n,8) center(mp,13) center(mdr,30)   /*display #, mp, mdr.*/
    end   /*j*/                       /* [↑] show MP and MDR for each #*/

say; target=25 say 'MDR first ' target " numbers that have a matching MDR" say '═══ ' copies("═",10+(target+2)**2%2)

    do k=0  for 10;  hits=0;  _=      /*show #'s that have an MDR of K.*/
    if k==7  then _=@7;   else        /*handle special seven case.     */
      do m=0  until hits==target      /*find five #'s with an MDR of K.*/
      ?=right(m,1)                    /*obtain right-most digit of  M. */
      if k\==0     then if ?==0                   then iterate
        select
        when k==3  then if ?\==1 & ?\==3          then iterate
        when k==5  then if ?//2==0                then iterate
        when k==7  then if ?\==1 & ?\==7          then iterate
        when k==9  then if ?\==1 & ?\==3 & ?\==9  then iterate
        otherwise  nop
        end   /*select*/
      if k==1  then m=copies(1,hits+1)
               else if word(mdr(m),2)\==k          then iterate
      hits=hits+1;  _=space(_ m',')   /*yes, we got a hit, add to list.*/
      end   /*m*/                     /* [↑]  built a list of MDRs = k */
    say " "k':     ['strip(_,,',')"]" /*display the  K  (mdr) and list.*/
    if k==3  then @7=translate(_,7,k) /*save for later, special 7 case.*/
    end     /*k*/                     /* [↑]  done with the K mdr list.*/

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────MDR subroutine──────────────────────*/ mdr: procedure; parse arg y; y=abs(y) /*get the number and find the MDR*/

  do p=1  until  y<10                 /*find multiplicative digRoot (Y)*/
  parse var y 1 r 2;  do k=2  to length(y);  r=r*substr(y,k,1); end;  y=r
  end   /*p*/                         /*wash, rinse, repeat ···        */

return p r /*return the persistence and MDR.*/</lang> output (when TARGET=5) is the same as the idiomatic version.

output (when TARGET=20):

 number   persistence   multiplicative digital root
────────  ───────────   ───────────────────────────
  123321       3                     8
    7739       3                     8
     893       3                     2
  899998       2                     0

MDR       first  25  numbers that have a matching MDR
═══   ══════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════
 0:     [0, 10, 20, 25, 30, 40, 45, 50, 52, 54, 55, 56, 58, 59, 60, 65, 69, 70, 78, 80, 85, 87, 90, 95, 96]
 1:     [1, 11, 111, 1111, 11111, 111111, 1111111, 11111111, 111111111, 1111111111, 11111111111, 111111111111, 1111111111111, 11111111111111, 111111111111111, 1111111111111111, 11111111111111111, 111111111111111111, 1111111111111111111, 11111111111111111111, 111111111111111111111, 1111111111111111111111, 11111111111111111111111, 111111111111111111111111, 1111111111111111111111111]
 2:     [2, 12, 21, 26, 34, 37, 43, 62, 73, 112, 121, 126, 134, 137, 143, 162, 173, 211, 216, 223, 232, 261, 278, 279, 287]
 3:     [3, 13, 31, 113, 131, 311, 1113, 1131, 1311, 3111, 11113, 11131, 11311, 13111, 31111, 111113, 111131, 111311, 113111, 131111, 311111, 1111113, 1111131, 1111311, 1113111]
 4:     [4, 14, 22, 27, 39, 41, 72, 89, 93, 98, 114, 122, 127, 139, 141, 172, 189, 193, 198, 212, 217, 221, 249, 266, 271]
 5:     [5, 15, 35, 51, 53, 57, 75, 115, 135, 151, 153, 157, 175, 315, 351, 355, 359, 395, 511, 513, 517, 531, 535, 539, 553]
 6:     [6, 16, 23, 28, 32, 44, 47, 48, 61, 68, 74, 82, 84, 86, 116, 123, 128, 132, 144, 147, 148, 161, 168, 174, 182]
 7:     [7, 17, 71, 117, 171, 711, 1117, 1171, 1711, 7111, 11117, 11171, 11711, 17111, 71111, 111117, 111171, 111711, 117111, 171111, 711111, 1111117, 1111171, 1111711, 1117111]
 8:     [8, 18, 24, 29, 36, 38, 42, 46, 49, 63, 64, 66, 67, 76, 77, 79, 81, 83, 88, 92, 94, 97, 99, 118, 124]
 9:     [9, 19, 33, 91, 119, 133, 191, 313, 331, 911, 1119, 1133, 1191, 1313, 1331, 1911, 3113, 3131, 3311, 9111, 11119, 11133, 11191, 11313, 11331]

Tcl

<lang tcl>proc mdr {n} {

   if {$n < 0 || ![string is integer $n]} {

error "must be an integer"

   }
   for {set i 0} {$n > 9} {incr i} {

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

   }
   return [list $i $n]

}</lang> Demonstrating: <lang tcl>puts "Number: MP MDR" puts [regsub -all . "Number: MP MDR" -] foreach n {123321 7739 893 899998} {

   puts [format "%6d: %2d %3d" $n {*}[mdr $n]]

} puts ""

The longEnough variable counts how many roots have at least 5 values accumulated for them

for {set i [set longEnough 0]} {$longEnough < 10} {incr i} {

   set root [lindex [mdr $i] 1]
   if {[llength [lappend accum($root) $i]] == 5} {incr longEnough}

} puts "MDR: \[n\u2080\u2026n\u2084\]" puts [regsub -all . "MDR: \[n\u2080\u2026n\u2084\]" -] for {set i 0} {$i < 10} {incr i} {

   puts [format "%3d: (%s)" $i [join [lrange $accum($i) 0 4] ", "]]

}</lang>

Output:

Number: MP MDR
--------------
123321:  3   8
  7739:  3   8
   893:  3   2
899998:  2   0

MDR: [n₀…n₄]
------------
  0: (0, 10, 20, 25, 30)
  1: (1, 11, 111, 1111, 11111)
  2: (2, 12, 21, 26, 34)
  3: (3, 13, 31, 113, 131)
  4: (4, 14, 22, 27, 39)
  5: (5, 15, 35, 51, 53)
  6: (6, 16, 23, 28, 32)
  7: (7, 17, 71, 117, 171)
  8: (8, 18, 24, 29, 36)
  9: (9, 19, 33, 91, 119)

zkl

Translation of: Python

<lang zkl>fcn mdroot(n){ // Multiplicative digital root

  mdr := List(n);
  while (mdr[-1] > 9){
     mdr.append(mdr[-1].toString().apply("toInt").reduce('*,1));
  }
  return(mdr.len() - 1, mdr[-1]);

}</lang> <lang zkl>fcn mdroot(n){

  count:=0; mdr:=n;
  while(mdr > 9){
     m:=mdr; digitsMul:=1;
     while(m){

reg md; m,md=m.divr(10); digitsMul *= md;

     }
     mdr = digitsMul;
     count += 1;
  }
  return(count, mdr);

}</lang> <lang zkl>println("Number: (MP, MDR)\n======= ========="); foreach n in (T(123321, 7739, 893, 899998))

 { println("%7,d: %s".fmt(n, mdroot(n))) }

table:=D([0..9].zip(fcn{List()}).walk()); // dictionary(0:List, 1:List, ...) n :=0; while(table.values.filter(fcn(r){r.len()<5})){ // until each entry has >=5 values

  mpersistence, mdr := mdroot(n);
  table[mdr].append(n);
  n += 1;

} println("\nMP: [n0..n4]\n== ========"); foreach mp in (table.keys.sort()){

  println("%2d: %s".fmt(mp, table[mp][0,5])); //print first five values