aoc2020/scripts/aoc.rkt

#lang curly-fn racket

;; utilities for every challenge script

(require "aoc-lib.rkt" threading syntax/parse/define (for-syntax racket/syntax) graph)
(provide answer dbg memoize define/memoized
         band bor bxor bnot bshl bshr bset? bfield
         maximum-bipartite-matching/stable
         (all-from-out threading syntax/parse/define graph)
         (for-syntax (all-from-out racket/syntax)))

;; in-expression debug print, uwu
(define (dbg x)
  (pretty-write x)
  x)

(define band bitwise-and)
(define bor bitwise-ior)
(define bxor bitwise-xor)
(define bnot bitwise-not)
(define bshl arithmetic-shift)
(define bshr #{arithmetic-shift %1 (- %2)})
(define bset? bitwise-bit-set?)
(define bfield bitwise-bit-field)

;; makes a memoization wrapper around a function
(define (memoize func)
  (define memo (make-hash))
  (lambda args
    (hash-ref! memo args (λ () (apply func args)))))

(define-simple-macro (define/memoized (name:id arg:id ...) body:expr ...+)
  (define name (memoize (λ (arg ...) body ...))))

;; helper for maximum-bipartite-matching
;; given an edge list where each first item corresponds to the left set and each second item
;; corresponds to the right set, return a matching list where the first item is from the left set
;; and the second item is from the right
(define (maximum-bipartite-matching/stable edges)
  (when (empty? edges) (error "provided empty edges list"))
  (define left (list->set (map first edges)))
  (define G (undirected-graph edges))
  (define matching (maximum-bipartite-matching G))
  (define num-first-lefts
    (for/sum ([m (in-list matching)] #:when (set-member? left (first m)))
      1))
  ;; if the first set contains more elements belonging to lefts than rights, then assume it's in
  ;; the right order. otherwise, swap
  (if (> num-first-lefts (- (length matching) num-first-lefts))
    matching
    (map #{list (second %) (first %)} matching)))

;; submit a solution to the server if not already submitted
(define (answer day part answer)
  (printf "answer ~a.~a: ~s\n" day part answer)
  (unless (aoc-complete? day part)
    (printf "submit? [Y/n]: ")
    (match (string-downcase (string-trim (read-line)))
      [(or "" "y" "yes")
       (printf "submitting...\n")
       (define resp
         (aoc-submit-answer (getenv "AOC_YEAR") (~a day) (getenv "AOC_SESSION") (~a part)
                            (~a answer)))
       (printf "server responded: ~a\n" resp)]
      [_ (printf "not submitting\n")])))