diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index 55faea1c..d8d6663e 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -9,23 +9,23 @@ ;; queens problem ;; place queens on chessboard so they do not intersect -(define board-size 8) +(define board-size 12) - (define queens (make-csp)) - (define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) - (define rows (range (length qs))) - (add-vars! queens qs rows) - (define (q-col q) (string->number (string-trim (symbol->string q) "q"))) - (for* ([qs (in-combinations qs 2)]) - (match-define (list qa qb) qs) - (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))) +(define queens (make-csp)) +(define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) +(define rows (range (length qs))) +(add-vars! queens qs rows) +(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) +(for* ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (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))) -(time-avg 10 (solve queens)) +#;(time-avg 10 (solve queens)) (parameterize ([current-solver min-conflicts]) (time-named (solve queens))) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 36042e0b..78ee3fd9 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -415,26 +415,34 @@ (define (random-pick xs) (list-ref xs (random (length xs)))) +(define (assign-random-vals csp) + (for/fold ([new-csp csp]) + ([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)]) + (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]) (($csp?) (integer?) . ->* . generator?) - ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. + ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. (generator () - (let loop ([csp0 csp]) - ;; Generate a complete assignment for all variables (probably with conflicts) - (define starting-assignment - (for/fold ([csp csp0]) - ([var (in-vars csp0)]) - (define name (var-name var)) - (assign-val csp name (random-pick ($csp-vals csp0 name))))) - ;; Now repeatedly choose a random conflicted variable and change it - (for/fold ([csp starting-assignment]) - ([i (in-range max-steps)]) - (match (conflicted-var-names csp) - [(? empty?) (yield csp) (loop csp0)] - [names - (define name (random-pick names)) - (define val (min-conflicts-value csp name ($csp-vals csp0 name))) - (assign-val csp name val)]))))) + (for ([thread-count 4]) ; todo: what is ideal thread quantity? + (make-min-conflcts-thread csp max-steps)) + (let loop () + (yield (thread-receive)) + (loop)))) (define/contract (conflicted-var-names csp) ($csp? . -> . (listof name?))