Refactored Day 4.

lib.rkt

@@ -21,12 +21,19 @@
          show-vector-grid
          show-hash-grid
 
-         ∘ ∂ $ %
+         ∘ ∂ ∂r $ %
          uncurry
+         apply*
+         apply-when
+
+         string->number*
+         string->symbol*
+
+         nchar=?
+         char-alphanumeric?
 
          sum
-         != nchar=?
+         !=
-         char-alphanumeric?
          nzero?
          negate
          pos-or-zero
@@ -54,12 +61,22 @@
 ;; Function helpers ;;
 (define ∘ compose)
 (define ∂ curry)
+(define ∂r curryr)
 
 ;; uncurry : (a1 -> ... -> an -> b) -> ((listof a) -> b)
 (define uncurry
   (curry apply))
 (define $ uncurry)
 
+;; apply* : (a -> b) -> a -> b
+(define (apply* f a)
+  (f a))
+
+;; apply-when : a -> (a -> b) -> b
+;; Apply given function only when a is not #f; return #f otherwise
+(define (apply-when p f)
+  (and p (f p)))
+
 
 ;; IO helpers ;;
 
@@ -137,6 +154,17 @@
   (show-vector-grid char-hash (hash->vectors hash-grid default)))
 
 
+;; Conversion helpers ;;
+
+;; string->number* : (or/c string? #f) -> (or/c number? #f)
+(define (string->number* s)
+  (and (string? s) (string->number s)))
+
+;; string->symbol* : (or/c string? #f) -> (or/c symbol? #f)
+(define (string->symbol* s)
+  (and (string? s) (string->symbol s)))
+
+
 ;; Char helpers ;;
 
 ;; nchar=? : char -> char -> boolean

src/04.rkt

@@ -19,65 +19,56 @@ hgt:179cm
 hcl:#cfa07d eyr:2025 pid:166559648
 iyr:2011 ecl:brn hgt:59in")
 
-(define fields '(byr iyr eyr hgt hcl ecl pid)) ;; except 'cid
+(struct passport
-(define ecls '(amb blu brn gry grn hzl oth))
+  (byr iyr eyr hgt hcl ecl pid cid)
+  #:transparent)
+
+(define default-passport
+  (passport #f #f #f #f #f #f #f #f))
+
+(define (passport-set entry pass)
+  (let ([value (second entry)])
+    (match (first entry)
+      ['byr (struct-copy passport pass [byr value])]
+      ['iyr (struct-copy passport pass [iyr value])]
+      ['eyr (struct-copy passport pass [eyr value])]
+      ['hgt (struct-copy passport pass [hgt value])]
+      ['hcl (struct-copy passport pass [hcl value])]
+      ['ecl (struct-copy passport pass [ecl value])]
+      ['pid (struct-copy passport pass [pid value])]
+      ['cid (struct-copy passport pass [cid value])]
+      [else pass])))
+
+(define (hgt? str)
+  (match str
+    [(regexp #px"^(\\d{3})cm$" (list _ hgt)) (<= 150 (string->number hgt) 193)]
+    [(regexp #px"^(\\d{2})in$" (list _ hgt)) (<= 59 (string->number hgt) 76)]
+    [_ #f]))
 
 (define (passports in)
-  (define (interp-value field value-string)
+  (let* ([passport-entries (map (compose
-    (match field
+                                 (∂ map (compose
-      ['byr (string->number value-string)]
+                                         (∂ map ∂ (list string->symbol identity))
-      ['iyr (string->number value-string)]
+                                         (∂r string-split ":")))
-      ['eyr (string->number value-string)]
+                                 (∂r string-split " ")
-      ['hgt (cond
+                                 (∂r string-replace "\n" " "))
-              [(string-suffix? value-string "in")
-               (cons 'in (string->number (string-trim value-string "in")))]
-              [(string-suffix? value-string "cm")
-               (cons 'cm (string->number (string-trim value-string "cm")))]
-              [else (cons 'na (string->number value-string))])]
-      ['hcl (string->list value-string)]
-      ['ecl (string->symbol value-string)]
-      ['pid (string->list value-string)]
-      ['cid value-string]))
-  (let* ([passport-strings (map (λ (p) (string-replace p "\n" " "))
                                 (string-split in "\n\n"))]
-         [passport-entries (map (λ (p) (map (curryr string-split ":")
+         [passports (map (∂ foldl passport-set default-passport)
-                                            (string-split p " ")))
+                         passport-entries)]
-                                passport-strings)]
+         [valid-raw? (struct/c passport string? string? string? string? string? string? string? any/c)]
-         [passport-hashes (map (λ (p)
+         [valid? (struct/c passport
-                                 (for/hash ([entry p])
+                           (and/c string? (∘ (integer-in 1920 2002) string->number))
-                                   (let* ([field (string->symbol (first entry))]
+                           (and/c string? (∘ (integer-in 2010 2020) string->number))
-                                          [value (interp-value field (second entry))])
+                           (and/c string? (∘ (integer-in 2020 2030) string->number))
-                                     (values field value))))
+                           hgt?
-                               passport-entries)])
+                           (and/c string? (∂ regexp-match-exact? #px"#[[:xdigit:]]{6}"))
-    passport-hashes))
+                           (apply or/c '("amb" "blu" "brn" "gry" "grn" "hzl" "oth"))
+                           (and/c string? (∂ regexp-match-exact? #px"\\d{9}"))
+                           any/c)])
+    (values (count valid-raw? passports)
+            (count valid? passports))))
 
-(define part1
+(define-values (part1 part2)
-  (count (λ (p) (andmap (∂ hash-has-key? p) fields))
+  (passports input))
-         (passports input)))
-
-(define part2
-  (count
-   (λ (p)
-     (and (andmap (∂ hash-has-key? p) fields)
-          (match-let ([byr (hash-ref p 'byr)]
-                      [iyr (hash-ref p 'iyr)]
-                      [eyr (hash-ref p 'eyr)]
-                      [`(,unit . ,hgt) (hash-ref p 'hgt)]
-                      [`(,hash ,hex ...) (hash-ref p 'hcl)]
-                      [ecl (hash-ref p 'ecl)]
-                      [pid (hash-ref p 'pid)])
-            (and (<= 1920 byr 2002)
-                 (<= 2010 iyr 2020)
-                 (<= 2020 eyr 2030)
-                 (match unit
-                   ['cm (<= 150 hgt 193)]
-                   ['in (<= 59 hgt 76)]
-                   [else #f])
-                 (char=? #\# hash)
-                 (= (length hex) 6)
-                 (andmap (curry char-alphanumeric?) hex)
-                 (member ecl ecls)
-                 (= (length pid) 9)))))
-   (passports input)))
 
 (show-solution part1 part2)