main
Matthew Butterick 6 years ago
parent eee5f20812
commit b7ed47677a

@ -130,28 +130,35 @@
[select_unassigned_variable first_unassigned_variable]
[order_domain_values unordered_domain_values]
[inference no_inference])
(($csp?) (procedure? procedure? procedure?) . ->* . generator?)
(generator ()
;; todo: incorporate `yield`
(let backtrack ([assignment (make-hasheq)])
(match (select_unassigned_variable assignment csp)
[#false (and (goal_test csp assignment) (yield assignment))]
[var
(cond
[(for/or ([val (in-list (order_domain_values var assignment csp))]
#:when (zero? (nconflicts csp var val assignment)))
(assign csp var val assignment)
(define removals (suppose csp var val))
(cond
[(and (inference csp var val assignment removals) (backtrack assignment))]
[else (restore csp removals) #false]))]
[else (unassign csp var assignment) #false])]))))
(($csp?) (procedure? procedure? procedure?) . ->* . (or/c #f assignment?))
(define (backtrack [assignment (make-hasheq)])
;; todo: convert to generator with `yield`
(let/ec return
(when (all-variables-assigned? csp assignment)
(return assignment))
(define var (select_unassigned_variable assignment csp))
(for ([val (in-list (order_domain_values var assignment csp))]
#:when (zero? (nconflicts csp var val assignment)))
(assign csp var val assignment)
(define removals (suppose csp var val))
(when (inference csp var val assignment removals)
(define result (backtrack assignment))
(when result
(return result))
(restore csp removals)))
(unassign csp var assignment)
(return #false)))
(define result (backtrack))
(unless (or (false? result) (goal_test csp result))
(error 'whut))
result)
;; todo: make multiple results work
(define/contract (solve* csp [solver backtracking_search] [finish-proc values]
#:count [solution-limit +inf.0])
(($csp?) (procedure? procedure? #:count integer?) . ->* . (or/c #f (non-empty-listof any/c)))
(match (for/list ([solution (in-producer (solver csp) (void))]
(match (for/list ([solution (in-value (solver csp))] ; needs generator here
[idx (in-range solution-limit)])
(finish-proc solution))
[(? pair? solutions) solutions]

Loading…
Cancel
Save