tidier

2017/d01/main.rkt

@@ -2,7 +2,7 @@
 
 (provide (rename-out [#%mb #%module-begin]))
 (define-macro (#%mb (STARS) (NUMBER) ...)
-  #'(#%module-begin (captcha-sum 'STARS NUMBER) ...))
+  #'(#%module-begin (time (captcha-sum 'STARS NUMBER) ...)))
 
 (define (captcha-sum stars num)
   (define digits (number->digits num))

2017/d02/main.rkt

@@ -2,7 +2,7 @@
 
 (provide (rename-out [#%mb #%module-begin]))
 (define-macro (#%mb (STARS) (NUMBER ...) ...)
-  #'(#%module-begin (checksum 'STARS '((NUMBER ...) ...))))
+  #'(#%module-begin (time (checksum 'STARS '((NUMBER ...) ...)))))
 
 (define (checksum stars intss)
   (define (max-min-diff ints) (- (apply max ints) (apply min ints)))

2017/d03/main.rkt

@@ -2,7 +2,7 @@
 
 (provide (rename-out [#%mb #%module-begin]))
 (define-macro (#%mb (STARS) (NUMBER) ...)
-  #'(#%module-begin ((if (eq? 'STARS '★) dist larger-sum) NUMBER) ...))
+  #'(#%module-begin (time ((if (eq? 'STARS '★) dist larger-sum) NUMBER) ...)))
 
 (define (ring-side r) (* 2 r))
 (define (ring-last r) (expt (add1 (ring-side r)) 2))

2017/d04/main.rkt

@@ -3,9 +3,9 @@
 (provide (rename-out [#%mb #%module-begin]))
 (define-macro (#%mb (STARS) (WORD ...) ...)
   #'(#%module-begin
-     (for/sum ([ws (in-list '((WORD ...) ...))]
-               #:when (no-duplicates? ws #:anagrams? (eq? 'STARS '★★)))
-       1)))
+     (time (for/sum ([ws (in-list '((WORD ...) ...))]
+                     #:when (no-duplicates? ws #:anagrams? (eq? 'STARS '★★)))
+             1))))
 
 (define (sort-chars word)
   (sort (string->list (symbol->string word)) char<?))

2017/d05/main.rkt

@@ -3,7 +3,7 @@
 (provide (rename-out [#%mb #%module-begin]))
 (define-macro (#%mb (STARS) (JMP) ...)
   #`(#%module-begin
-     (escape (list->vector '(JMP ...)) 'STARS)))
+     (time (escape (list->vector '(JMP ...)) 'STARS))))
 
 (define (escape vec stars)
   (let/ec exit
@@ -12,8 +12,8 @@
       (unless (<= 0 pos (sub1 (vector-length vec)))
         (exit i))
       (define jmp (vector-ref vec pos))
-      (vector-set! vec pos (if (and (eq? stars '★★) (>= jmp 3))
-                               (sub1 jmp)
-                               (add1 jmp)))
+      (vector-set! vec pos ((if (and (eq? stars '★★) (>= jmp 3))
+                                sub1
+                                add1) jmp))
       (+ pos jmp))))
 

2017/d06/main.rkt

@@ -3,7 +3,7 @@
 (provide (rename-out [#%mb #%module-begin]))
 (define-macro (#%mb (STARS) (BANK ...))
   #`(#%module-begin
-     (count-redists (list->vector '(BANK ...)) 'STARS)))
+     (time (count-redists (list->vector '(BANK ...)) 'STARS))))
 
 (define (redist starting-vec)
   (define vec (vector-copy starting-vec))

2017/d08/main.rkt

@@ -3,8 +3,9 @@
 
 (define-macro (#%mb (STARS) (TOK ...) ...)
   #`(#%module-begin
-     (inst TOK ...) ...
-     (if (eq? 'STARS '★) (max-arg vals) max-seen)))
+     (time
+      (inst TOK ...) ...
+      (if (eq? 'STARS '★) (max-arg vals) max-seen))))
 
 (define vals (make-hasheq))
 (define (get-val key) (hash-ref! vals key 0))

2017/d09/main.rkt

@@ -8,10 +8,10 @@
 
 (define-macro (#%mb STARS-LINE SEXP-LINE ...)
   #`(#%module-begin
-     (if (eq? (process-line STARS-LINE) '★)
-         (score (process-line SEXP-LINE))
-         (process-line SEXP-LINE #t))
-     ...))
+     (time (if (eq? (process-line STARS-LINE) '★)
+               (score (process-line SEXP-LINE))
+               (process-line SEXP-LINE #t))
+           ...)))
 
 (define (process-line line [garbage #f])
   (define gchars 0)

2017/d10/main.rkt

@@ -11,7 +11,7 @@
 
 (define-macro (#%mb STARS RANGE-IN STR)
   #`(#%module-begin
-     ((if (eq? 'STARS '★) one-star two-star) RANGE-IN STR)))
+     (time ((if (eq? 'STARS '★) one-star two-star) RANGE-IN STR))))
 
 (define (one-star range-in str)
   (define lens (with-input-from-string (string-replace str "," " ")
@@ -36,7 +36,7 @@
               [len (in-list lens)])
     (define posns (for/list ([i (in-range len)])
                             (modulo (+ current-position i) range-in)))
-    (for ([val (in-list (map (curry vector-ref vec) posns))]
+    (for ([val (in-list (map (λ (posn) (vector-ref vec posn)) posns))]
           [posn (in-list (reverse posns))])
          (vector-set! vec posn val))
     (values (+ current-position len skip-size) (add1 skip-size)))

2017/d11/main.rkt

@@ -3,7 +3,7 @@
 
 (define-macro (#%mb (STARS) (HEX ...) ...)
   #'(#%module-begin
-     ((if (eq? 'STARS '★) one-star two-star) (list HEX ...)) ...))
+     (time ((if (eq? 'STARS '★) one-star two-star) (list HEX ...)) ...)))
 
 (define origin '(0 0 0))
 (define ne '(1 0 -1)) (define sw '(-1 0 1))

2017/d12/main.rkt

@@ -4,17 +4,18 @@
 
 (define-macro (#%mb (STARS) (NUM <-> . NUMS) ...)
   #'(#%module-begin
-     (define g (unweighted-graph/undirected null))
-     (for-each (curry add-edge! g NUM) (list . NUMS)) ...     
-     (if (eq? 'STARS '★)
-         (programs-in-group g 0)
-         (number-of-groups g (list NUM ...)))))
+     (time
+      (define g (unweighted-graph/undirected null))
+      (for-each (curry add-edge! g NUM) (list . NUMS)) ...     
+      (if (eq? 'STARS '★)
+          (programs-in-group g 0)
+          (number-of-groups g (list NUM ...))))))
 
 (define (programs-in-group g x) (length (group-of g x)))
 
 (define (group-of g x)
   (define-values (connects _) (dijkstra g x))
-  (for/list ([(k v) (in-hash connects)]
+  (for/list ([(k v) (in-mutable-hash connects)]
              #:when (integer? v))
     k))
 

2017/d13/main.rkt

@@ -6,7 +6,7 @@
   (with-pattern ([(DEPTH ...)
                   (for/list ([id (in-syntax #'(DEPTH: ...))])
                     (string->number (string-trim (symbol->string (syntax->datum id)) ":")))])
-    #'(#%module-begin (STARS '(DEPTH ...) '(RANGE ...)))))
+    #'(#%module-begin (time (STARS '(DEPTH ...) '(RANGE ...))))))
 
 (define (caught? depth range [delay 0])
   (zero? (modulo (+ depth delay) (* 2 (sub1 range)))))

2017/d14/main.rkt

@@ -4,17 +4,21 @@
 
 (define-macro (#%mb (STARS) (STR) ...)
   #`(#%module-begin
-     ((if (eq? 'STARS '★) one-star two-star) (format "~a" 'STR)) ...))
+     (time ((if (eq? 'STARS '★) one-star two-star) (format "~a" 'STR))) ...))
+
+(define (knot-hashes str)
+  (for/list ([i (in-range 128)])
+    (knot-hash (format "~a-~a" str i))))
 
 (define (one-star str)
-  (for*/sum ([i (in-range 128)]
-             [digit (in-list (kh->ints (knot-hash (format "~a-~a" str i))))])
-    digit))
+  (for*/sum ([kh (in-list (knot-hashes str))]
+             [int (in-list (kh->ints kh))])
+    int))
 
 (define (two-star str)
-  (define vec (for*/vector ([i (in-range 128)]
-                            [int (in-list (kh->ints (knot-hash (format "~a-~a" str i))))])
-                (if (= int 1) "#" ".")))
+  (define vec (for*/vector ([kh (in-list (knot-hashes str))]
+                            [int (in-list (kh->ints kh))])
+                (if (= int 1) 'used 'empty)))
   (define (at-left-edge? idx) (= (modulo idx 128) 0))
   (define (at-right-edge? idx) (= (modulo idx 128) 127))
   (for/fold ([region 0])
@@ -22,11 +26,12 @@
              #:unless (number? val))
     (let loop ([idx idx])
       (cond
-        [(and (< -1 idx (vector-length vec)) (equal? (vector-ref vec idx) "#"))
+        [(and (<= 0 idx (sub1 (vector-length vec))) (eq? (vector-ref vec idx) 'used))
          (vector-set! vec idx region)
          (unless (at-left-edge? idx) (loop (sub1 idx)))
          (unless (at-right-edge? idx) (loop (add1 idx)))
-         (map loop (list (+ idx 128) (- idx 128)))
+         (loop (+ idx 128))
+         (loop (- idx 128))
          (add1 region)]
         [else region]))))
 
@@ -34,7 +39,7 @@
   (for*/list ([c (in-string kh)]
               [num (in-value (string->number (string c) 16))]
               [c (in-string (~r num #:base 2 #:min-width 4 #:pad-string "0"))])
-    (string->number (string c))))
+    (if (char=? c #\1) 1 0)))
 
 (define (knot-hash seed-str [range-in 256])
   (define ascii-chars (map char->integer (string->list seed-str)))
@@ -52,7 +57,7 @@
               [len (in-list lens)])
     (define posns (for/list ([i (in-range len)])
                     (modulo (+ current-position i) range-in)))
-    (for ([val (in-list (map (curry vector-ref vec) posns))]
+    (for ([val (in-list (map (λ (posn) (vector-ref vec posn)) posns))]
           [posn (in-list (reverse posns))])
       (vector-set! vec posn val))
     (values (+ current-position len skip-size) (add1 skip-size)))

2017/d15/main.rkt

@@ -3,26 +3,26 @@
 
 (define-macro (#%mb (STARS) (Generator X starts with NUM) ...)
   #`(#%module-begin
-     (apply STARS '(NUM ...))))
+     (time (STARS 'NUM ...))))
 
 (define (lower-16-bits x) (bitwise-bit-field x 0 16))
 
-(define (generator-base a b rounds [modulo-a 1] [modulo-b 1])
-  (for/fold ([a-last a]
-             [b-last b]
+(define (generator-fold start factor mod)
+  (for/fold ([val start])
+            ([i (in-naturals)]
+             #:break (and (positive? i) (zero? (modulo val mod))))
+    (remainder (* factor val) 2147483647)))
+
+(define (generator-base a-start b-start rounds [modulo-a 1] [modulo-b 1])
+  (for/fold ([a-start a-start]
+             [b-start b-start]
              [sum 0]
              #:result sum)
             ([i (in-range rounds)])
-    (define a (for/fold ([a a-last])
-                        ([i (in-naturals)]
-                         #:break (and (positive? i) (zero? (modulo a modulo-a))))
-                (remainder (* 16807 a) 2147483647)))
-    (define b (for/fold ([b b-last])
-                        ([i (in-naturals)]
-                         #:break (and (positive? i) (zero? (modulo b modulo-b))))
-                (remainder (* 48271 b) 2147483647)))
+    (define a (generator-fold a-start 16807 modulo-a))
+    (define b (generator-fold b-start 48271 modulo-b))
     (values a b (+ sum (if (= (lower-16-bits a) (lower-16-bits b)) 1 0)))))
 
-(define (★ a-start b-start) (generator-base a-start b-start 40000000))
+(define (★ a-start b-start) (generator-base a-start b-start (* 40 1000000)))
 
-(define (★★ a-start b-start) (generator-base a-start b-start 5000000 4 8))
+(define (★★ a-start b-start) (generator-base a-start b-start (* 5 1000000) 4 8))

2017/d15/star2.rkt

@@ -1,3 +1,3 @@
-#lang reader "main.rkt" ★★
+#lang reader "main.rkt" ★★ ; 336
 Generator A starts with 783
 Generator B starts with 325