min-con
parent
bb1033ca3e
commit
62c11e1676
@ -0,0 +1,25 @@
|
|||||||
|
#lang br
|
||||||
|
(require "aima.rkt" sugar/debug)
|
||||||
|
|
||||||
|
|
||||||
|
;; queens problem
|
||||||
|
;; place queens on chessboard so they do not intersect
|
||||||
|
(define qs (for/list ([q 8]) (string->symbol (format "q~a" q))))
|
||||||
|
(define rows (range (length qs)))
|
||||||
|
(define vds (for/list ([q qs])
|
||||||
|
($vd q (range (length qs)))))
|
||||||
|
(define (q-col q) (string->number (string-trim (symbol->string q) "q")))
|
||||||
|
(define cs (for*/list ([qs (in-combinations qs 2)])
|
||||||
|
(match-define (list qa qb) qs)
|
||||||
|
(match-define (list qa-col qb-col) (map q-col qs))
|
||||||
|
($constraint
|
||||||
|
(list qa qb)
|
||||||
|
(λ (qa-row qb-row)
|
||||||
|
(and
|
||||||
|
(not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal?
|
||||||
|
(not (= qa-row qb-row)))))))
|
||||||
|
|
||||||
|
(define queens (make-csp vds cs))
|
||||||
|
|
||||||
|
(current-solver min-conflicts)
|
||||||
|
(time-named (solve queens))
|
@ -1,7 +1,28 @@
|
|||||||
#lang debug racket
|
#lang debug racket
|
||||||
(require sugar "hacs.rkt")
|
(require sugar/debug "hacs.rkt")
|
||||||
|
|
||||||
(current-inference forward-check)
|
(current-inference forward-check)
|
||||||
(current-select-variable mrv)
|
(current-select-variable mrv)
|
||||||
(current-order-values shuffle)
|
(current-order-values shuffle)
|
||||||
(current-shuffle #true)
|
(current-shuffle #true)
|
||||||
|
|
||||||
|
;; queens problem
|
||||||
|
;; place queens on chessboard so they do not intersect
|
||||||
|
(define queens (make-csp))
|
||||||
|
(define qs (for/list ([q 10]) (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-named (solve queens))
|
||||||
|
(parameterize ([current-solver min-conflicts])
|
||||||
|
(time-named (solve queens)))
|
Loading…
Reference in New Issue