0. #lang racket
1. ; numeric core
2. ; given a number with 4 or more digits, split digits into 4 numbers without changing the order
3. ; apply operators - * / in the order that produces the smallest whole (natural?) result
4. ; if result has more than 3 digits, repeat from the top
5. ; final number with less than four digits is the numeric core of the larger number
6. ;
7. ; e.g. 86455
8. ; becomes 8 6 45 5
9. ; becomes 8, -6, *45, /5
10. ; core = 18
11. ;
12. ; e.g. 45292
13. ; becomes 45 2 9 2
14. ; becomes 45, *2, /9, -2
15. ; core = 8
16. (define (numeric-core n)
17.   (let* ([digits (number->digits n)]
18.          [core (case (length digits)
19.                  [(1 2 3) n]
20.                  #;[(4) (apply split-core digits)]
21.                  #;[(5) (apply five-digit-core digits)]
22.                  [else (n-digit-core digits)])])
23.     ; if core has more than 3 digits, recalculate with resulting core as new start
24.     (if (< core 1000) core
25.         (numeric-core core))))
26. #;(numeric-core 86455) ; => 18
27. #;(numeric-core 45292) ; => 8
28.  
29. ; minimum value in finite sequence of numbers or '() for empty sequence
30. (define (sequence-minimum seq)
31.   (sequence-fold (λ (a b) (if (null? a) b (min a b))) null seq))
32.  
33. ; given a character in range #\0 to #\9, convert to number represented by character
34. (define (char-digit->integer c)
35.   (- (char->integer c) (char->integer #\0)))
36. #;(char-digit->integer #\3) ; => 3
37. #;(char-digit->integer #\6) ; => 6
38.  
39. ; split a natural number into its digits
40. (define (number->digits n)
41.   (let ([chars (string->list (number->string n))])
42.     (map char-digit->integer chars)))
43. #;(number->digits 4) ; => '(4)
44. #;(number->digits 12) ; => '(1 2)
45. #;(number->digits 123) ; => '(1 2 3)
46.  
47. ; combine a list of single digit numbers into one number containing digits in given order
48. (define (digits->number digits)
49.   (foldl (λ (n acc) (+ (* acc 10) n)) 0 digits))
50. #;(digits->number '(1 2 3)) ; => 123
51.  
52. ; merge two natural numbers into one resulting number by appending their digits
53. (define (merge-digits a b)
54.   (digits->number (append (number->digits a)
55.                           (number->digits b))))
56. #;(merge 1 2) ; => 12
57. #;(merge 12 3) ; => 123
58. #;(merge 1 23) ; => 123
59.  
60. ; remove repeats from given list
61. (define (uniqify lst)
62.   (let loop ([seen (set)]
63.              [lst lst]
64.              [acc '()])
65.     (if (empty? lst) (reverse acc)
66.         (let ([a (first lst)])
67.           (loop (set-add seen a)
68.                 (rest lst)
69.                 (if (set-member? seen a) acc
70.                     (cons a acc)))))))
71.  
72. ; smallest natural result from applying math to 4 given numbers
73. ; #false if no natural core exists for given numbers
74. (define (split-core a b c d)
75.   (define ops (list - * /)) ; plus is implied
76.   (define (compute ops)
77.     (match ops
78.       [(list o1 o2 o3)
79.        (o3 (o2 (o1 a b) c) d)]))
80.   (let* ([computed-results (sequence-map compute (in-permutations ops))]
81.          [potential-cores (sequence-filter natural? computed-results)]
82.          [core (sequence-minimum potential-cores)])
83.     (if (number? core) core #false)))
84. #;(split-core 8 6 45 5) ; => 18
85. #;(split-core 45 2 9 2) ; => 8
86.  
87. ; initial idea exploring how to find 4 number candidates in a 5 digit input
88. ; replaced with n-digit-core below
89. #;(define (five-digit-core a b c d e)
90.     (let* ([candidates (list (list (merge-digits a b) c d e)
91.                              (list a (merge-digits b c) d e)
92.                              (list a b (merge-digits c d) e)
93.                              (list a b c (merge-digits d e)))]
94.            [potential-cores (filter-map (curry apply split-core) candidates)])
95.       (if (empty? potential-cores)
96.           #false
97.           (apply min potential-cores))))
98. #;(five-digit-core 8 6 4 5 5) ; => 18
99.  
100. ; merge numbers until there are 4 numbers (filters output to only return unique results
101. ; resulting candidate list's length will correspond to https://oeis.org/A000292 Tetrahedral numbers
102. ; if input is 4 or fewer digits, output will have 1 candidate
103. ; if input is 5 digits, output will have 4 candidates
104. ; if input is 6 digits, output will have 10 candidates
105. (define (potential-merges digits)
106.   (case (length digits)
107.     [(1 2 3 4) (list digits)]
108.     [else
109.      (uniqify
110.       (append-map potential-merges
111.                   (let loop ([head '()]
112.                              [tail digits]
113.                              [acc '()])
114.                     (match tail
115.                       [(list-rest a b rest)
116.                        (loop (append head (list a))
117.                              (cons b rest)
118.                              (cons (append head
119.                                            (list (merge-digits a b))
120.                                            rest)
121.                                    acc))]
122.                       [_ (reverse acc)]))))]))
123. #;(potential-merges '(1 2)) ; => '((1 2))
124. #;(potential-merges '(1 2 3 4)) ; => '((1 2 3 4))
125. #;(potential-merges '(1 2 3 4 5)) ; => '((12 3 4 5) (1 23 4 5) (1 2 34 5) (1 2 3 45))
126. #;(potential-merges '(1 2 3 4 5 6))
127. ; => '((123 4 5 6) (12 34 5 6) (12 3 45 6) (12 3 4 56) (1 234 5 6)
128. ;      (1 23 45 6) (1 23 4 56) (1 2 345 6) (1 2 34 56) (1 2 3 456))
129.  
130. ;
131. (define (n-digit-core digits)
132.   (let* ([candidates (potential-merges digits)]
133.          [potential-cores (filter-map (curry apply split-core) candidates)])
134.     (if (empty? potential-cores)
135.         #false
136.         (apply min potential-cores))))
137. #;(n-digit-core '(8 6 4 5 5)) ; => 18
138.  
139. (define (display-core n)
140.   (displayln (~a "Numeric core of " n " is " (numeric-core n))))
141. (display-core 86455)
142. (display-core 45292)

=>

Numeric core of 86455 is 18

Numeric core of 45292 is 8