master
Matthew Butterick 3 years ago
parent 26b362a416
commit 5c0e3efc07

@ -4,7 +4,8 @@
(match-define (list fields my-ticket other-tickets) (match-define (list fields my-ticket other-tickets)
(string-split (file->string "16.rktd") "\n\n")) (string-split (file->string "16.rktd") "\n\n"))
(struct predicate (name func) #:transparent) (struct predicate (name func) #:transparent
#:property prop:procedure 1)
(define predicates (define predicates
(for/list ([field (string-split fields "\n")]) (for/list ([field (string-split fields "\n")])
(match (regexp-match #px"^(.*?): (\\d+)-(\\d+) or (\\d+)-(\\d+)$" field) (match (regexp-match #px"^(.*?): (\\d+)-(\\d+) or (\\d+)-(\\d+)$" field)
@ -21,7 +22,7 @@
(check-equal? (for*/sum ([ticket (cdr (string-split other-tickets "\n"))] (check-equal? (for*/sum ([ticket (cdr (string-split other-tickets "\n"))]
[ticket-int (ticket->ints ticket)] [ticket-int (ticket->ints ticket)]
#:unless (for/or ([pred predicates]) #:unless (for/or ([pred predicates])
((predicate-func pred) ticket-int))) (pred ticket-int)))
ticket-int) 26988) ticket-int) 26988)
(define all-tickets (cdr (string-split other-tickets "\n"))) (define all-tickets (cdr (string-split other-tickets "\n")))
@ -29,7 +30,7 @@
(define (ticket-valid? ticket) (define (ticket-valid? ticket)
(for/and ([intvec (ticket->ints ticket)]) (for/and ([intvec (ticket->ints ticket)])
(for/or ([pred predicates]) (for/or ([pred predicates])
((predicate-func pred) intvec)))) (pred intvec))))
(define valid-tickets (filter ticket-valid? all-tickets)) (define valid-tickets (filter ticket-valid? all-tickets))
@ -39,7 +40,7 @@
(for ([(col colidx) (in-indexed cols)]) (for ([(col colidx) (in-indexed cols)])
(hash-set! col-preds colidx (hash-set! col-preds colidx
(apply mutable-set (for/list ([(pred predidx) (in-indexed predicates)] (apply mutable-set (for/list ([(pred predidx) (in-indexed predicates)]
#:when (andmap (predicate-func pred) col)) #:when (andmap pred col))
predidx)))) predidx))))
(define assignment (make-hasheq)) (define assignment (make-hasheq))
@ -66,21 +67,20 @@
;; CSP solution ;; CSP solution
(require csp) (require csp)
(define col-pred-prob (make-csp)) (define prob (make-csp))
(define var-names (make-var-names "col" (range (length cols)))) (define colidxs (range (length cols)))
(add-vars! col-pred-prob var-names (range (length cols))) (add-vars! prob colidxs (range (length predicates)))
(add-pairwise-constraint! col-pred-prob alldiff var-names) (add-all-diff-constraint! prob #:proc eq?)
(for ([(colvar colidx) (in-indexed var-names)]) (for ([colidx (in-list colidxs)])
(add-constraint! col-pred-prob (add-constraint! prob
(λ (predidx) (andmap (predicate-func (list-ref predicates predidx)) (λ (predidx) (andmap (list-ref predicates predidx)
(list-ref cols colidx))) (list colvar))) (list-ref cols colidx))) (list colidx)))
(define csp-assignment (define csp-assignment
(parameterize ([current-select-variable mrv-degree-hybrid] (parameterize ([current-select-variable mrv-degree-hybrid]
[current-order-values shuffle] [current-order-values shuffle]
[current-node-consistency #t]) [current-node-consistency #t])
(for/list ([(col predidx) (in-dict (solve col-pred-prob))]) (solve prob)))
(define colidx (string->number (car (regexp-match #px"\\d+" (~a col))))) (print-debug-info)
(cons colidx predidx))))
(check-equal? (test-assignment csp-assignment) 426362917709) (check-equal? (test-assignment csp-assignment) 426362917709)