8.rkt

#lang racket

(require threading)
(module+ rackunit)

(struct line (wires output) #:transparent)

(define (parse-list lst)
  (map (compose list->set string->list string-trim) (string-split lst " ")))

(define (parse-line l)
  (define parts (string-split l "|"))
  (line (parse-list (first parts))
        (parse-list (second parts))))

(define lines
  (~>
#;
   '(
     "acedgfb cdfbe gcdfa fbcad dab cefabd cdfgeb eafb cagedb ab | cdfeb fcadb cdfeb cdbaf")
   
   (with-input-from-file
       "/tmp/input"
     (λ ()
       (port->lines (current-input-port))))
   (map parse-line _)))

(define ∈ member)
(define ∪ set-union)
(define ∩ set-intersect)

(define (set-length s)
  (length (set->list s)))

(define (find-len lst len)
  (match lst
    ['() (error "Looking for non-existant length")]
    [(cons f r)
     (if (= (set-length f) len)
         f
         (find-len r len))]))

(define (find-lens lst len)
  (filter (λ (s) (= (set-length s) len)) lst))

(define (max-by a b f)
  (if (> (f a) (f b)) a b))

(define (min-by a b f)
  (if (> (f a) (f b)) b a))

(define (build-mapping wires)
  (make-hash
   (map
    pair-reverse
    `((0 . ,(find-zero wires))
      (1 . ,(find-len wires 2))
      (2 . ,(find-two wires))
      (3 . ,(find-three wires))
      (4 . ,(find-len wires 4))
      (5 . ,(find-five wires))
      (6 . ,(find-six wires))
      (7 . ,(find-len wires 3))
      (8 . ,(find-len wires 7))
      (9 . ,(find-nine wires))))))

(define (pair-reverse c)
  (match c
    [`(,a . ,b) `(,b . ,a)]))

(define (find-two wires)
  (∪
   (find-bars wires)
   (set (find-top-right wires) (find-bottom-left wires))))

(define (find-three wires)
  (∪ (find-bars wires) (find-right-side wires)))

(define (find-five wires)
  (∪ (find-bars wires)
     (set (find-top-left wires) (find-bottom-right wires))))

(define (find-nine wires)
  (∪
   (find-bars wires)
   (find-right-side wires)
   (set (find-top-left wires))))

(define (find-right-side wires)
  (find-len wires 2))

(define (find-top wires)
  (define seven (find-len wires 3))
  (define one (find-len wires 2))
  (set-subtract seven one))

(define (find-bars wires)
  (define two-three-five (find-lens wires 5))
  (apply ∩ two-three-five))

(define (find-middle wires)
  (define four (find-len wires 4)) 
  (define bars (find-bars wires))
  (∩ four bars))

(define (find-zero wires)
  (define eight (find-len wires 7))
  (define middle (find-middle wires))
  (set-subtract eight middle))

(define (find-bottom wires)
  (set-subtract (find-bars wires)
                (∪ (find-middle wires) (find-top wires))))

(define (find-left-side wires)
  (define right (find-right-side wires))
  (define top-&-bot (∪ (find-top wires) (find-bottom wires)))
  (define zero (find-zero wires))
  (set-subtract zero (∪ top-&-bot right)))


(define/contract (find-bottom-right wires)
  (-> any/c char?)
  (define left (find-left-side wires))
  (define right (set->list (find-right-side wires)))
  (define bars (find-bars wires))
  (define-values (a b) (values
                        (first right)
                        (second right)))
  (if (∈ (∪ left bars (set a)) wires)
      a
      b))

(define/contract (find-top-right wires)
  (-> any/c char?)
  (first
   (set->list (set-subtract (find-right-side wires)
                            (set (find-bottom-right wires))))))

(define/contract (find-bottom-left wires)
  (-> any/c char?)
  (define left (set->list (find-left-side wires)))
  (define-values (a b)
    (values
     (first left)
     (second left)))
  (if (∈ (∪ (set a)
            (find-bars wires)
            (set (find-bottom-right wires))) wires)
      b a))

(define/contract (find-top-left wires)
  (-> any/c char?)
  (first
   (set->list
    (set-subtract (find-left-side wires)
                  (set (find-bottom-left wires))))))

(define (find-six wires)
  (define left (find-left-side wires))
  (define bars (find-bars wires))
  (define bottom-right (find-bottom-right wires))
  (∪ left bars (set bottom-right)))
      

(define (solve-line line)
  (define m (build-mapping (line-wires line)))
  (match (map (λ (s) (hash-ref m s)) (line-output line))
    [(list th hun ten one)
     (+ (* 1000 th)
        (* 100 hun)
        (* 10 ten)
        one)]))
   
    
(apply + (map solve-line lines))