Browse Source

cheat

canon
Hazel Levine 7 months ago
parent
commit
0847c7af34
Signed by: hazel GPG Key ID: 1884029A28789A62
  1. 2
      aux/day11-viz.rkt
  2. 2
      aux/day12.rkt
  3. 0
      aux/day15-unsafe.rkt
  4. 2
      aux/day16-solver.rkt
  5. 111
      aux/day19-monad.rkt
  6. 49
      aux/day19-mps.rkt
  7. 1
      data/day19.test2.txt
  8. 120
      day19.rkt

2
day11-viz.rkt → aux/day11-viz.rkt

@ -1,5 +1,5 @@
#lang racket
(require "day11.rkt"
(require "../day11.rkt"
2htdp/image)
(provide main)

2
day12.rkt → aux/day12.rkt

@ -1,5 +1,5 @@
#lang racket
(require "lib/common.rkt")
(require "../lib/common.rkt")
;; broken rn

0
day15-unsafe.rkt → aux/day15-unsafe.rkt

2
day16-solver.rkt → aux/day16-solver.rkt

@ -1,5 +1,5 @@
#lang rosette/safe
(require "day16.rkt")
(require "../day16.rkt")
(provide (all-defined-out))
(struct rule (idx lower1 upper1 lower2 upper2) #:transparent)

111
aux/day19-monad.rkt

@ -0,0 +1,111 @@
#lang racket
(require "../lib/common.rkt"
data/applicative data/either data/monad
megaparsack megaparsack/parser-tools/lex
parser-tools/lex (prefix-in : parser-tools/lex-sre))
(provide (all-defined-out))
(struct rule (idx obj) #:transparent)
(struct orr (left right) #:transparent)
(define-tokens rules [NUMBER CHARACTER])
(define-empty-tokens rules* [COLON PIPE QUOTE NEWLINE])
(define number/p (token/p 'NUMBER))
(define character/p (token/p 'CHARACTER))
(define colon/p (token/p 'COLON))
(define pipe/p (token/p 'PIPE))
(define quote/p (token/p 'QUOTE))
(define newline/p (token/p 'NEWLINE))
(define rules-lexer
(lexer-src-pos
[#\: (token-COLON)]
[#\| (token-PIPE)]
[#\" (token-QUOTE)]
[#\newline (token-NEWLINE)]
[(:+ (:/ #\0 #\9))
(token-NUMBER (string->number lexeme))]
[(:+ (:/ #\a #\z))
(token-CHARACTER lexeme)]
[(:or whitespace blank iso-control) (void)]
[(eof) eof]))
(define number-list/p (many/p number/p))
(define quoted-char/p
(do quote/p
[ch <- character/p]
quote/p
(pure (string-ref ch 0))))
(define piped-numbers/p
(do [lhs <- number-list/p]
pipe/p
[rhs <- number-list/p]
(pure (orr lhs rhs))))
(define rule-rhs/p (or/p quoted-char/p (try/p piped-numbers/p) number-list/p))
(define rule/p
(do [idx <- number/p]
colon/p
[object <- rule-rhs/p]
(pure (rule idx object))))
(define rules/p (many/p rule/p #:sep newline/p))
(define (parse prt)
(match-define `(,rls ,msgs) (string-split (port->string prt) "\n\n"))
(define rls/parsed (parse-result! (parse-tokens rules/p (lex-string rules-lexer rls))))
(define rls/hash
(for/hash ([v (in-list rls/parsed)])
(values (rule-idx v) v)))
(values rls/hash (string-split msgs "\n")))
; Char String -> [Either String String]
(define (validate-char ch msg)
(if (and (char=? (string-ref msg 0) ch)
(non-empty-string? msg))
(success (substring msg 1))
(failure (format "did not match char ~a" ch))))
; [Hashof Number Rule] [Listof Index] String -> [Either String String]
(define (validate-list rls indices msg)
(for/fold ([acc (success msg)])
([index (in-list indices)])
(chain (curry validate-message rls index) acc)))
; [Hashof Number Rule] [Listof Index] [Listof Index] String -> [Either String String]
(define (validate-or rls lhs rhs msg)
(define res-lhs (validate-list rls lhs msg))
(if (success? res-lhs) res-lhs (validate-list rls rhs msg)))
; [Hashof Number Rule] Index String -> [Either String String]
(define (validate-message rls idx msg)
(cond [(non-empty-string? msg)
(define cur-rule (hash-ref rls idx))
(match (rule-obj cur-rule)
[ch #:when (char? ch)
(validate-char ch msg)]
[indices #:when (list? indices)
(validate-list rls indices msg)]
[(orr lhs rhs)
(validate-or rls lhs rhs msg)])]
[else (success "")]))
(define (day19a rls msgs)
(for/sum ([msg (in-list msgs)])
(define res (validate-message rls 0 msg))
(if (and (success? res)
(string=? (from-success #f res) ""))
1 0)))
(module+ main
(call-with-input-file "data/day19.txt"
(λ (prt)
(define-values (rls msgs) (parse prt))
(answer 19 1 (day19a rls msgs)))))
(module+ test
(call-with-input-file "data/day19.test.txt"
(λ (prt)
(define-values (rls msgs) (parse prt))
(displayln (validate-message rls 0 (fifth msgs)))
(displayln (day19a rls msgs)))))

49
day19-dumb.rkt → aux/day19-mps.rkt

@ -1,5 +1,5 @@
#lang racket
(require "lib/common.rkt"
(require "../lib/common.rkt"
data/applicative data/either data/monad
megaparsack megaparsack/parser-tools/lex megaparsack/text
memoize
@ -69,8 +69,8 @@
(do prs (gen-rule-parser rls idx))))
(define/memo (gen-or-parser rls left right)
(or/p (lazy/p (gen-concat-parser rls left))
(lazy/p (gen-concat-parser rls right))))
(or/p (gen-concat-parser rls left)
(gen-concat-parser rls right)))
(define/memo (gen-rule-parser rls idx)
(define cur (hash-ref rls idx))
@ -82,39 +82,44 @@
[(orr left right)
(gen-or-parser rls left right)]))
(define (message/p rls) (gen-rule-parser rls 0))
(define (gen-counts rls)
(do [rule42 <- (many/p (try/p (gen-rule-parser rls 42)))]
[rule31 <- (many/p (try/p (gen-rule-parser rls 31)))]
(pure (cons (length rule42) (length rule31)))))
(define (day19a rls msgs)
(define hell/p (message/p rls))
(for/sum ([msg (in-list msgs)])
(if (success? (parse-string hell/p msg)) 1 0)))
(define (rule-8/p rls)
; 8: 42 | 42 8 => 42 42*
(many+/p (gen-rule-parser rls 42)))
(define (rule-11/p rls)
; 11: 42 31 | 42 11 31 => 42 (42 (42 ... 31) 31) 31
(do (gen-rule-parser rls 42)
(many/p (rule-11/p rls)) ; optional
(gen-rule-parser rls 31)))
(define (rule-0/p rls)
; 0: 8 11
(do (rule-8/p rls)
(rule-11/p rls)))
(define (day19b rls msgs)
; 8: 42 | 42 8
; 11: 42 31 | 42 11 31
(define new-rls
(hash-set* rls
8 (rule 8 (orr (list 42) (list 42 8)))
11 (rule 11 (orr (list 42 31) (list 42 11 31)))))
(day19a new-rls msgs))
(for/sum ([msg (in-list msgs)])
; shoot first ask questions later
(with-handlers ([exn:fail? (lambda (_) 0)])
(match-define (cons rule42 rule31)
(parse-result! (dbg (parse-string (gen-counts rls) msg))))
1)))
(module+ main
(call-with-input-file "data/day19.txt"
(λ (prt)
(define-values (rls msgs) (parse prt))
(answer 19 1 (day19a rls msgs))
(answer 19 2 (day19b rls msgs)))))
(module+ test
(call-with-input-file "data/day19.test.txt"
(λ (prt)
(define-values (rls msgs) (parse prt))
(displayln (day19a rls msgs))))
(call-with-input-file "data/day19.test2.txt"
(λ (prt)
(define-values (rls msgs) (parse prt))
(displayln (day19b rls msgs))
; minimal breaking example
(displayln (day19b rls
(list "aaabbbbbbaaaabaababaabababbabaaabbababababaaa"))))))

1
data/day19.test2.txt

@ -30,7 +30,6 @@
7: 14 5 | 1 21
24: 14 1
abbbbbabbbaaaababbaabbbbabababbbabbbbbbabaaaa
bbabbbbaabaabba
babbbbaabbbbbabbbbbbaabaaabaaa

120
day19.rkt

@ -1,13 +1,12 @@
#lang racket
(require "lib/common.rkt"
data/applicative data/either data/monad
data/applicative data/monad
megaparsack megaparsack/parser-tools/lex
parser-tools/lex (prefix-in : parser-tools/lex-sre))
(provide (all-defined-out))
(struct rule (idx obj) #:transparent)
(struct orr (left right) #:transparent)
(struct star (indices) #:transparent)
(define-tokens rules [NUMBER CHARACTER])
(define-empty-tokens rules* [COLON PIPE QUOTE NEWLINE])
@ -57,88 +56,45 @@
(define rls/hash
(for/hash ([v (in-list rls/parsed)])
(values (rule-idx v) v)))
(values rls/hash (string-split msgs "\n")))
; Char String -> [Either String String]
(define (validate-char ch msg)
(printf "char: ~a, ~a\n" msg ch)
(if (and (char=? (string-ref msg 0) ch)
(non-empty-string? msg))
(success (substring msg 1))
(failure (format "did not match char ~a" ch))))
; [Hashof Number Rule] [Listof Index] String -> [Either String String]
(define (validate-list rls indices msg)
(printf "list: ~a, ~a\n" msg indices)
(for/fold ([acc (success msg)])
([index (in-list indices)])
(define fn
(match index
[(star indices) (curry validate-star rls indices)]
[n #:when (number? n) (curry validate-message rls n)]))
(chain fn acc)))
; [Hashof Number Rule] [Listof Index] String -> [Either String String]
(define (validate-star rls indices msg)
(let loop ([ret msg])
(printf "star: ~a, ~a\n" ret indices)
(define res (validate-list rls indices ret))
(cond [(failure? res) (success ret)]
[else
(define unpacked (from-success #f res))
(if (non-empty-string? unpacked)
(loop unpacked)
(success ""))])))
; [Hashof Number Rule] [Listof Index] [Listof Index] String -> [Either String String]
(define (validate-or rls lhs rhs msg)
(printf "or: ~a, ~a, ~a\n" msg lhs rhs)
(define res-lhs (validate-list rls lhs msg))
(define res-rhs (validate-list rls rhs msg))
(cond [(and (success? res-lhs)
(success? res-rhs))
; not entirely sure what to do here...
(define unpacked-lhs (from-success #f res-lhs))
(define unpacked-rhs (from-success #f res-rhs))
(cond [(>= (string-length unpacked-lhs) (string-length unpacked-rhs))
res-lhs]
[else res-rhs])]
[(success? res-lhs) res-lhs]
[(success? res-rhs) res-rhs]
[else (failure "did not match or")]))
; [Hashof Number Rule] Index String -> [Either String String]
(define (validate-message rls idx msg)
(cond [(non-empty-string? msg)
(define cur-rule (hash-ref rls idx))
(printf "msg: ~a\n" msg)
(match (rule-obj cur-rule)
[ch #:when (char? ch)
(validate-char ch msg)]
[indices #:when (list? indices)
(validate-list rls indices msg)]
[(orr lhs rhs)
(validate-or rls lhs rhs msg)])]
[else (success "")]))
(define (day19a rls msgs)
(define brag-formatted
(string-append*
(for/list ([(_ rl) (in-hash rls)])
(match-define (rule idx obj) rl)
(format "rule~a: ~a\n" idx
(match obj
[ch #:when (char? ch) (format "\"~a\"" ch)]
[indices #:when (list? indices)
(string-join (map (compose1 (curry string-append "rule") number->string) indices) " ")]
[(orr lhs rhs)
(string-append
(string-join (map (compose1 (curry string-append "rule") number->string) lhs) " ")
" | "
(string-join (map (compose1 (curry string-append "rule") number->string) rhs) " "))])))))
(define brag-data
(string-append "#lang brag\ntop: rule0\n" brag-formatted))
(define tmp (make-temporary-file))
(call-with-output-file tmp
(λ (prt)
(write-string brag-data prt))
#:exists 'truncate)
(define parse (dynamic-require tmp 'parse))
(for/sum ([msg (in-list msgs)])
(define res (validate-message rls 0 msg))
(if (and (success? res)
(string=? (from-success #f res) ""))
1 0)))
(with-handlers ([exn:fail? (lambda (_) 0)])
(parse msg) 1)))
(define (day19b rls msgs)
; 8: 42 | 42 8 => 8: 42 42*
; 11: 42 31 | 42 11 31 => 11: 42 (42 31)* 31
; 8: 42 | 42 8
; 11: 42 31 | 42 11 31
(define new-rls
(hash-set* rls
8 (rule 8 (list 42 (star (list 42))))
11 (rule 11 (list 42 (star (list 42 31)) 31))))
; (day19a new-rls msgs)
; minimal breaking example, should match for test data:
(day19a new-rls (list "aaabbbbbbaaaabaababaabababbabaaabbababababaaa")))
8 (rule 8 (orr (list 42) (list 42 8)))
11 (rule 11 (orr (list 42 31) (list 42 11 31)))))
(day19a new-rls msgs))
(module+ main
(call-with-input-file "data/day19.txt"
@ -146,15 +102,3 @@
(define-values (rls msgs) (parse prt))
(answer 19 1 (day19a rls msgs))
(answer 19 2 (day19b rls msgs)))))
(module+ test
(call-with-input-file "data/day19.test.txt"
(λ (prt)
(define-values (rls msgs) (parse prt))
(displayln (validate-message rls 0 (fifth msgs)))
(displayln (day19a rls msgs))))
(call-with-input-file "data/day19.test2.txt"
(λ (prt)
(define-values (rls msgs) (parse prt))
(displayln (day19b rls msgs)))))
Loading…
Cancel
Save