we'll see

main
Matthew Butterick 6 years ago
parent 4896a2b7e4
commit 43a30be843

@ -9,7 +9,7 @@
;; queens problem ;; queens problem
;; place queens on chessboard so they do not intersect ;; place queens on chessboard so they do not intersect
(define board-size 12) (define board-size 8)
(define queens (make-csp)) (define queens (make-csp))
(define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) (define qs (for/list ([q board-size]) (string->symbol (format "q~a" q))))
@ -26,6 +26,6 @@
(= qa-row qb-row))) ; same row? (= qa-row qb-row))) ; same row?
(list qa qb))) (list qa qb)))
#;(time-avg 10 (solve queens)) (time-avg 10 (solve queens))
(parameterize ([current-solver min-conflicts]) (parameterize ([current-solver min-conflicts])
(time-named (solve queens))) (time-named (solve queens)))

@ -175,7 +175,7 @@
(make-csp (vars csp) (make-csp (vars csp)
(for/list ([constraint (in-constraints csp)]) (for/list ([constraint (in-constraints csp)])
(cond (cond
[(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity constraint)))
(partially-assigned? constraint)) (partially-assigned? constraint))
(match-define ($constraint cnames proc) constraint) (match-define ($constraint cnames proc) constraint)
($constraint (filter-not assigned-name? cnames) ($constraint (filter-not assigned-name? cnames)
@ -327,6 +327,8 @@
(define/contract (constraint-checkable? c names) (define/contract (constraint-checkable? c names)
($constraint? (listof name?) . -> . any/c) ($constraint? (listof name?) . -> . any/c)
;; constraint is checkable if all constraint names
;; are in target list of names.
(for/and ([cname (in-list ($constraint-names c))]) (for/and ([cname (in-list ($constraint-names c))])
(memq cname names))) (memq cname names)))
@ -349,10 +351,10 @@
(var-name var))) (var-name var)))
(define-values (checkable-constraints other-constraints) (define-values (checkable-constraints other-constraints)
(partition (λ (c) (and (constraint-checkable? c singleton-varnames) (partition (λ (c) (and (constraint-checkable? c singleton-varnames)
(if mandatory-names (or (not mandatory-names)
(for/and ([name (in-list mandatory-names)]) (for/and ([name (in-list mandatory-names)])
(constraint-relates? c name)) (constraint-relates? c name)))))
#true))) (constraints csp))) (constraints csp)))
(cond (cond
[conflict-count? (define conflict-count [conflict-count? (define conflict-count
(for/sum ([constraint (in-list checkable-constraints)] (for/sum ([constraint (in-list checkable-constraints)]
@ -440,9 +442,8 @@
(generator () (generator ()
(for ([thread-count 4]) ; todo: what is ideal thread quantity? (for ([thread-count 4]) ; todo: what is ideal thread quantity?
(make-min-conflcts-thread csp max-steps)) (make-min-conflcts-thread csp max-steps))
(let loop () (for ([i (in-naturals)])
(yield (thread-receive)) (yield (thread-receive)))))
(loop))))
(define/contract (conflicted-var-names csp) (define/contract (conflicted-var-names csp)
($csp? . -> . (listof name?)) ($csp? . -> . (listof name?))
@ -457,7 +458,7 @@
(define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts csp name val)) (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts csp name val))
#:cache-keys? #true)) #:cache-keys? #true))
(for/first ([val (in-list vals-by-conflict)] (for/first ([val (in-list vals-by-conflict)]
#:unless (equal? val (first ($csp-vals csp name)))) #:unless (equal? val (first ($csp-vals csp name)))) ;; but change the value
val)) val))
(define no-value-sig (gensym)) (define no-value-sig (gensym))

Loading…
Cancel
Save