The multiplicative digital root (MDR) and multiplicative persistence (MP) of a number, 



n


{\displaystyle n}

, is calculated rather like the Digital root except digits are multiplied instead of being added:

 Set 



m


{\displaystyle m}

 to 



n


{\displaystyle n}

 and 



i


{\displaystyle i}

 to 



0


{\displaystyle 0}

.
 While 



m


{\displaystyle m}

 has more than one digit:
 Find a replacement 



m


{\displaystyle m}

 as the multiplication of the digits of the current value of 



m


{\displaystyle m}

.
 Increment 



i


{\displaystyle i}

.
 Return 



i


{\displaystyle i}

 (= MP) and 



m


{\displaystyle 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.

Similar

The Product of decimal digits of n page was redirected here, and had the following description


Find the product of the decimal digits of a positive integer   n,   where n <= 100

The three existing entries for Phix, REXX, and Ring have been moved here, under ===Similar=== headings, feel free to match or ignore them.



References

 Multiplicative Digital Root on Wolfram Mathworld.
 Multiplicative digital root on The On-Line Encyclopedia of Integer Sequences.
 What's special about 277777788888899? - Numberphile video


; 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 product of the digits of an integer.
 
(define integer-product-digits
  (lambda (integer)
    (fold-left * 1 (integer->list integer))))
 
; Compute the multiplicative digital root and multiplicative persistence of an integer.
; Return as a cons of (mdr . mp).
 
(define mdr-mp
  (lambda (integer)
    (let loop ((int integer) (cnt 0))
      (if (< int 10)
        (cons int cnt)
        (loop (integer-product-digits int) (1+ cnt))))))
 
; Emit a table of integer, multiplicative digital root, and multiplicative persistence
; for the example integers given.  Example list ends with sequence A003001 from OEIS.
 
(printf "~16@a ~6@a ~6@a~%" "Integer" "Root" "Pers.")
(printf "~16@a ~6@a ~6@a~%" "===============" "======" "======")
(let rowloop ((intlist '(123321 7739 893 899998
                         0 10 25 39 77 679 6788 68889 2677889 26888999 3778888999 277777788888899)))
  (when (pair? intlist)
    (let* ((int (car intlist))
           (mm (mdr-mp int)))
      (printf "~16@a ~6@a ~6@a~%" int (car mm) (cdr mm))
      (rowloop (cdr intlist)))))
 
; Emit a table of multiplicative digital root versus the first five integers having that MDR.
 
(newline)
(printf "~5@a ~a~%" "Root" "First five integers with that root")
(printf "~5@a ~a~%" "====" "==================================")
(let ((mdrslsts (make-vector 10 '())))
  (do ((integer 0 (1+ integer)))
      ((>= (fold-left min 5 (vector->list (vector-map length mdrslsts))) 5))
    (let ((mdr (car (mdr-mp integer))))
      (when (< (length (vector-ref mdrslsts mdr)) 5)
        (vector-set! mdrslsts mdr (append (vector-ref mdrslsts mdr) (list integer))))))
  (do ((mdr 0 (1+ mdr)))
      ((>= mdr 10))
    (printf "~5@a" mdr)
    (for-each (lambda (int) (printf "~7@a" int)) (vector-ref mdrslsts mdr))
    (newline)))