diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index 6d3194e9..df69806d 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -21,11 +21,10 @@ (match-define (list qa-col qb-col) (map q-col qs)) (add-constraint! queens (λ (qa-row qb-row) - (nor - (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal? - (= qa-row qb-row))) ; same row? - (list qa qb))) + (not (= (abs (- qa-row qb-row)) (abs (- (q-col qa) (q-col qb)))))) ; same diag? + (list qa qb)) + (add-constraint! queens (negate =) (list qa qb))) (time-avg 10 (solve queens)) -(parameterize ([current-solver min-conflicts]) +(parameterize ([current-solver min-conflicts-solver]) (time-named (solve queens))) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 40d7561d..e514c987 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -250,9 +250,13 @@ [(list winning-uvar) winning-uvar] [(list mrv-uvars ...) ;; use degree as tiebreaker for mrv - (define max-degree-arg (argmax (λ (var) (var-degree csp var)) mrv-uvars)) + (define degrees (map (λ (var) (var-degree csp var)) mrv-uvars)) + (define max-degree (apply max degrees)) ;; use random tiebreaker for degree - (random-pick (filter (λ (var) (= (var-degree csp max-degree-arg) (var-degree csp var))) mrv-uvars))])])) + (random-pick (for/list ([var (in-list mrv-uvars)] + [degree (in-list degrees)] + #:when (= max-degree degree)) + var))])])) (define first-domain-value values) @@ -422,26 +426,27 @@ ([name (in-var-names csp)]) (assign-val new-csp name (random-pick ($csp-vals csp name))))) -(define (make-min-conflcts-thread csp0 max-steps [main-thread (current-thread)]) +(define (make-min-conflcts-thread csp0 thread-count max-steps [main-thread (current-thread)]) (thread (λ () - ;; Generate a complete assignment for all variables (probably with conflicts) - (for/fold ([csp (assign-random-vals csp0)]) - ([nth-step (in-range max-steps)]) - ;; Now repeatedly choose a random conflicted variable and change it - (match (conflicted-var-names csp) - [(? empty?) (thread-send main-thread csp) csp] - [names - (define name (random-pick names)) - (define val (min-conflicts-value csp name ($csp-vals csp0 name))) - (assign-val csp name val)]))))) - -(define/contract (min-conflicts csp [max-steps 100]) + (let loop () + ;; Generate a complete assignment for all variables (probably with conflicts) + (for/fold ([csp (assign-random-vals csp0)]) + ([nth-step (in-range max-steps)]) + ;; Now repeatedly choose a random conflicted variable and change it + (match (conflicted-var-names csp) + [(? empty?) (thread-send main-thread csp) (loop)] + [names + (define name (random-pick names)) + (define val (min-conflicts-value csp name ($csp-vals csp0 name))) + (assign-val csp name val)])))))) + +(define/contract (min-conflicts-solver csp [max-steps 100]) (($csp?) (integer?) . ->* . generator?) ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. (generator () - (for ([thread-count 4]) ; todo: what is ideal thread quantity? - (make-min-conflcts-thread csp max-steps)) + (for ([thread-count 4]) ; todo: what is ideal thread count? + (make-min-conflcts-thread csp thread-count max-steps)) (for ([i (in-naturals)]) (yield (thread-receive))))) @@ -480,7 +485,8 @@ #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)] #:limit [max-solutions +inf.0]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit integer?) . ->* . (listof any/c)) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) + . ->* . (listof any/c)) (when-debug (reset-assns!) (reset-nfcs!) @@ -491,10 +497,13 @@ (define/contract (solve csp #:finish-proc [finish-proc csp->assocs] - #:solver [solver (or (current-solver) backtracking-solver)]) - ((csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c)) - (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit 1) + #:solver [solver (or (current-solver) backtracking-solver)] + #:limit [max-solutions 1]) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) + . ->* . (or/c #false any/c)) + (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit max-solutions) [(list solution) solution] + [(list solutions ...) solutions] [else #false])) (define (<> a b) (not (= a b)))