Digital root/Multiplicative digital root: Difference between revisions

=={{header|Scheme}}==

{{works with|Chez Scheme}}

<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 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)))</lang>

{{out}}

<pre> Integer Root Pers.

=============== ====== ======

123321 8 3

7739 8 3

893 2 3

899998 0 2

0 0 0

10 0 1

25 0 2

39 4 3

77 8 4

679 6 5

6788 0 6

68889 0 7

2677889 0 8

26888999 0 9

3778888999 0 10

277777788888899 0 11

Root First five integers with that root

==== ==================================

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</pre>