#lang racket
(require threading)

; numeric core
; given a number with 4 or more digits, split digits into 4 numbers without changing the order
; apply operators - * / in the order that produces the smallest whole (natural?) result
; if result has more than 3 digits, repeat from the top
; final number with less than four digits is the numeric core of the larger number
;
; e.g. 86455
; becomes 8 6 45 5
; becomes 8, -6, *45, /5
; core = 18
;
; e.g. 45292
; becomes 45 2 9 2
; becomes 45, *2, /9, -2
; core = 8


; minimum value in finite sequence of numbers or '() for empty sequence
(define (sequence-minimum seq)
  (sequence-fold (λ (a b) (if (null? a) b (min a b))) null seq))

; given a character in range #\0 to #\9, convert to number represented by character
(define (char-digit->integer c)
  (- (char->integer c) (char->integer #\0)))
#;(char-digit->integer #\3) ; => 3
#;(char-digit->integer #\6) ; => 6

; split a natural number into its digits
(define number->digits
  (λ~> number->string
       string->list
       (map char-digit->integer _)))
#;(number->digits 4) ; => '(4)
#;(number->digits 12) ; => '(1 2)
#;(number->digits 123) ; => '(1 2 3)

; combine a list of single digit numbers into one number containing digits in given order
(define (digits->number digits)
  (foldl (λ (n acc) (+ (* acc 10) n)) 0 digits))
#;(digits->number '(1 2 3)) ; => 123

; merge two natural numbers into one resulting number by appending their digits
(define (merge-digits a b)
  (~> (append (number->digits a) (number->digits b))
      digits->number))
#;(merge 1 2) ; => 12
#;(merge 12 3) ; => 123
#;(merge 1 23) ; => 123

; remove repeats from given list
(define (uniqify lst)
  (let loop ([seen (set)]
             [lst lst]
             [acc '()])
    (if (empty? lst) (reverse acc)
        (let ([a (first lst)])
          (loop (set-add seen a)
                (rest lst)
                (if (set-member? seen a) acc
                    (cons a acc)))))))

; smallest natural result from applying math to 4 given numbers
; #false if no natural core exists for given numbers
(define (split-core a b c d)
  (define ops (list - * /)) ; plus is implied
  (define (compute ops)
    (match ops
      [(list o1 o2 o3)
       (~> a
           (o1 b)
           (o2 c)
           (o3 d))]))
  (let* ([computed-results (sequence-map compute (in-permutations ops))]
         [potential-cores (sequence-filter natural? computed-results)]
         [core (sequence-minimum potential-cores)])
    (if (number? core) core #false)))
#;(split-core 8 6 45 5) ; => 18
#;(split-core 45 2 9 2) ; => 8

; initial idea exploring how to find 4 number candidates in a 5 digit input
; replaced with n-digit-core below
#;(define (five-digit-core a b c d e)
    (let* ([candidates (list (list (merge-digits a b) c d e)
                             (list a (merge-digits b c) d e)
                             (list a b (merge-digits c d) e)
                             (list a b c (merge-digits d e)))]
           [potential-cores (filter-map (curry apply split-core) candidates)])
      (if (empty? potential-cores)
          #false
          (apply min potential-cores))))
#;(five-digit-core 8 6 4 5 5) ; => 18

; merge numbers until there are 4 numbers (filters output to only return unique results
; resulting candidate list's length will correspond to https://oeis.org/A000292 Tetrahedral numbers
; if input is 4 or fewer digits, output will have 1 candidate
; if input is 5 digits, output will have 4 candidates
; if input is 6 digits, output will have 10 candidates
(define (potential-merges digits)
  (case (length digits)
    [(1 2 3 4) (list digits)]
    [else (~> (let loop ([head '()]
                         [tail digits]
                         [acc '()])
                (match tail
                  [(list-rest a b rest)
                   (loop (append head (list a))
                         (cons b rest)
                         (cons (append head
                                       (list (merge-digits a b))
                                       rest)
                               acc))]
                  [_ (reverse acc)]))
              (append-map potential-merges _)
              (uniqify))]))
#;(potential-merges '(1 2)) ; => '((1 2))
#;(potential-merges '(1 2 3 4)) ; => '((1 2 3 4))
#;(potential-merges '(1 2 3 4 5)) ; => '((12 3 4 5) (1 23 4 5) (1 2 34 5) (1 2 3 45))
#;(potential-merges '(1 2 3 4 5 6))
; => '((123 4 5 6) (12 34 5 6) (12 3 45 6) (12 3 4 56) (1 234 5 6)
;      (1 23 45 6) (1 23 4 56) (1 2 345 6) (1 2 34 56) (1 2 3 456))

; 
(define (n-digit-core digits)
  (let* ([candidates (potential-merges digits)]
         [potential-cores (filter-map (curry apply split-core) candidates)])
    (if (empty? potential-cores)
        #false
        (apply min potential-cores))))
#;(n-digit-core '(8 6 4 5 5)) ; => 18

; main implementation of numeric-core
(define (numeric-core n)
  (let* ([digits (number->digits n)]
         [core (case (length digits)
                 [(1 2 3) n]
                 #;[(4) (apply split-core digits)]
                 #;[(5) (apply five-digit-core digits)]
                 [else (n-digit-core digits)])])
    ; if core has more than 3 digits, recalculate with resulting core as new start
    (if (< core 1000) core
        (numeric-core core))))

(define (display-core n)
  (displayln (~a "Numeric core of " n " is " (numeric-core n))))
(display-core 86455)
(display-core 45292)

standard-module-name-resolver: collection not found
  for module path: threading
  collection: "threading"
  in collection directories:
   /home/pasterack/.local/share/racket/8.8/collects
   /home/pasterack/racket88/collects/
   ... [179 additional linked and package directories]
  context...:
   /home/pasterack/racket88/collects/racket/require-transform.rkt:266:2: expand-import
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:648:16
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:646:2: filter-by-mode
   /home/pasterack/racket88/collects/racket/require-transform.rkt:266:2: expand-import
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:287:21: try-next
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:401:21: try-next
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:258:2
   /home/pasterack/racket88/collects/syntax/wrap-modbeg.rkt:46:4
   /home/pasterack/racket88/share/pkgs/scribble-lib/scribble/run.rkt:175:26: go
   .../private/map.rkt:40:19: loop
   .../racket/cmdline.rkt:191:51
   body of "/home/pasterack/racket88/share/pkgs/scribble-lib/scribble/run.rkt"