You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
75 lines
2.7 KiB
Racket
75 lines
2.7 KiB
Racket
#lang racket
|
|
(require rackunit "main.rkt")
|
|
|
|
|
|
;; Problem: fields
|
|
(check-equal? (get-field _solver (new problem% [solver 'solver-in])) 'solver-in)
|
|
(check-equal? (get-field _constraints (new problem%)) null)
|
|
(check-equal? (get-field _variable-domains (new problem%)) (make-hash))
|
|
|
|
(define problem null)
|
|
|
|
;; Problem: reset
|
|
(set! problem (new problem%))
|
|
(define early-solutions (send problem get-solutions))
|
|
(send problem add-variable "a" (range 3))
|
|
(check-not-equal? (send problem get-solutions) early-solutions)
|
|
(send problem reset)
|
|
(check-equal? (send problem get-solutions) early-solutions)
|
|
|
|
;; Problem: setSolver & get-solver
|
|
(define solver (new backtracking-solver%))
|
|
(set! problem (new problem% [solver solver]))
|
|
(check-true (solver%? (send problem get-solver)))
|
|
|
|
;; Problem: add-variable
|
|
(set! problem (new problem%))
|
|
(send problem add-variable "a" '(1 2))
|
|
(check-true (or (= (hash-ref (send problem get-solution) "a") 1)
|
|
(= (hash-ref (send problem get-solution) "a") 2)))
|
|
(check-exn exn:fail? (λ () (send problem add-variable "b" null))) ;; empty domain
|
|
|
|
|
|
;; Problem: add-variables
|
|
(set! problem (new problem%))
|
|
(send problem add-variables '("a" "b") '(1 2 3))
|
|
(check-equal? (length (send problem get-solutions)) 9)
|
|
|
|
;; Problem: add-constraint
|
|
(set! problem (new problem%))
|
|
(send problem add-variables '("a" "b") '(1 2 3))
|
|
(send problem add-constraint (λ(a b) (= a (add1 b))))
|
|
(check-equal? (length (send problem get-solutions)) 2)
|
|
|
|
|
|
;; FunctionConstraint, two ways: implicit and explicit
|
|
(send problem reset)
|
|
(send problem add-variables '(a b) '(1 2))
|
|
(send problem add-constraint <) ; implicit
|
|
(check-true (let ([s (sort (hash->list (send problem get-solution)) #:key cdr <)])
|
|
(or (equal? s '((a . 1) (b . 2))) (equal? s '((b . 1) (a . 2))))))
|
|
(send problem reset)
|
|
(send problem add-variables '(a b) '(1 2))
|
|
(send problem add-constraint (new function-constraint% [func <])) ; explicit
|
|
(check-true (let ([s (sort (hash->list (send problem get-solution)) #:key cdr <)])
|
|
(or (equal? s '((a . 1) (b . 2))) (equal? s '((b . 1) (a . 2))))))
|
|
|
|
;; AllDifferentConstraint
|
|
(send problem reset)
|
|
(send problem add-variables '(a b) '(1 2))
|
|
(send problem add-constraint (new all-different-constraint%))
|
|
(let ([solutions (send problem get-solutions)])
|
|
(check-equal? (hash-ref (first solutions) 'a) (hash-ref (second solutions) 'b))
|
|
(check-equal? (hash-ref (second solutions) 'a) (hash-ref (first solutions) 'b)))
|
|
|
|
|
|
;; AllEqualConstraint
|
|
(send problem reset)
|
|
(send problem add-variables '(a b) '(1 2))
|
|
(send problem add-constraint (new all-equal-constraint%))
|
|
(let ([solutions (send problem get-solutions)])
|
|
(check-equal? (hash-ref (first solutions) 'a) (hash-ref (first solutions) 'b))
|
|
(check-equal? (hash-ref (second solutions) 'a) (hash-ref (second solutions) 'b)))
|
|
|
|
|