day07.scm - advent-of-code - Perserverance, or the lack thereof

day07.scm (4023B)

    1 (use-modules (ice-9 popen))
    2 (use-modules (ice-9 rdelim))
    3 (use-modules (ice-9 format))
    4 (use-modules (ice-9 hash-table))
    5 (use-modules (srfi srfi-1))
    6 
    7 (define (score-card card)
    8   (case card
    9     ((#\A) 13)
   10     ((#\K) 12)
   11     ((#\Q) 11)
   12     ((#\J) 10)
   13     ((#\T) 9)
   14     ((#\9) 8)
   15     ((#\8) 7)
   16     ((#\7) 6)
   17     ((#\6) 5)
   18     ((#\5) 4)
   19     ((#\4) 3)
   20     ((#\3) 2)
   21     ((#\2) 1)
   22     (else #nil)))
   23 
   24 (define (check-hand hand)
   25   (let ((card-tally (make-hash-table)))
   26     (for-each (lambda (card) (hash-set! card-tally card (1+ (hash-ref card-tally card 0)))) (string->list hand))
   27     (let ((count (sort (hash-map->list (lambda (k v) v) card-tally) >)))
   28       (cond
   29        ((equal? count '(1 1 1 1 1)) 1)
   30        ((equal? count '(2 1 1 1)) 2)
   31        ((equal? count '(2 2 1)) 3)
   32        ((equal? count '(3 1 1)) 4)
   33        ((equal? count '(3 2)) 5)
   34        ((equal? count '(4 1)) 6)
   35        ((equal? count '(5)) 7)))))
   36 
   37 (define (hand-less-raw hand-a hand-b scorer)
   38   (if (and (null? hand-a) (null? hand-b))
   39       #f
   40       (let ((card-a (car hand-a))
   41             (card-b (car hand-b)))
   42         (if (eq? card-a card-b)
   43             (hand-less-raw (cdr hand-a) (cdr hand-b) scorer)
   44             (< (scorer card-a) (scorer card-b))))))
   45 
   46 (define (hand-less hand-a hand-b)
   47   (let ((hand-type-a (check-hand hand-a))
   48         (hand-type-b (check-hand hand-b)))
   49     (if (eq? hand-type-a hand-type-b)
   50         (hand-less-raw (string->list hand-a) (string->list hand-b) score-card)
   51         (< hand-type-a hand-type-b))))
   52 
   53 (define (calc-winning hands-and-bids sorted-hands curr-rank)
   54   (if (null? sorted-hands)
   55       0
   56       (+ (* curr-rank (hash-ref hands-and-bids (car sorted-hands)))
   57          (calc-winning hands-and-bids (cdr sorted-hands) (1+ curr-rank)))))
   58 
   59 (define (parse-input filename)
   60   (let ((file (open-input-file filename))
   61         (hands-and-bids (make-hash-table)))
   62     (while #t
   63            (let ((line (car (%read-line file))))
   64              (if (eof-object? line)
   65                  (break)
   66                  (let* ((tmp (string-split line #\ ))
   67                         (hand (car tmp))
   68                         (bid (string->number (car (cdr tmp)))))
   69                    (hash-set! hands-and-bids hand bid)))))
   70     hands-and-bids))
   71 
   72 (let* ((input (parse-input "input.txt"))
   73        (hands (hash-map->list (lambda (k v) k) input))
   74        (sorted-hands (sort hands hand-less)))
   75   ;; 249390788
   76   (format #t "Part 1: ~d" (calc-winning input sorted-hands 1))
   77   (newline))
   78 
   79 (define (score-card-2 card)
   80   (case card
   81     ((#\A) 13)
   82     ((#\K) 12)
   83     ((#\Q) 11)
   84     ((#\T) 9)
   85     ((#\9) 8)
   86     ((#\8) 7)
   87     ((#\7) 6)
   88     ((#\6) 5)
   89     ((#\5) 4)
   90     ((#\4) 3)
   91     ((#\3) 2)
   92     ((#\2) 1)
   93     ((#\J) 0)
   94     (else #nil)))
   95 
   96 (define (check-hand-2 hand)
   97   (let ((card-tally (make-hash-table))
   98         (wild-card-count 0))
   99     (for-each
  100      (lambda (card)
  101        (if (eq? card #\J)
  102            (set! wild-card-count (1+ wild-card-count))
  103            (hash-set! card-tally card (1+ (hash-ref card-tally card 0)))))
  104      (string->list hand))
  105     (let* ((count (sort (hash-map->list (lambda (k v) v) card-tally) >))
  106            (count-adjusted (if (null? count) '(5) (cons (+ wild-card-count (car count)) (cdr count)))))
  107       (cond
  108        ((equal? count-adjusted '(1 1 1 1 1)) 1)
  109        ((equal? count-adjusted '(2 1 1 1)) 2)
  110        ((equal? count-adjusted '(2 2 1)) 3)
  111        ((equal? count-adjusted '(3 1 1)) 4)
  112        ((equal? count-adjusted '(3 2)) 5)
  113        ((equal? count-adjusted '(4 1)) 6)
  114        ((equal? count-adjusted '(5)) 7)))))
  115 
  116 (define (hand-less-2 hand-a hand-b)
  117   (let ((hand-type-a (check-hand-2 hand-a))
  118         (hand-type-b (check-hand-2 hand-b)))
  119     (if (eq? hand-type-a hand-type-b)
  120         (hand-less-raw (string->list hand-a) (string->list hand-b) score-card-2)
  121         (< hand-type-a hand-type-b))))
  122 
  123 (let* ((input (parse-input "input.txt"))
  124        (hands (hash-map->list (lambda (k v) k) input))
  125        (sorted-hands (sort hands hand-less-2)))
  126   ;; 248750248
  127   (format #t "Part 2: ~d" (calc-winning input sorted-hands 1))
  128   (newline))