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.
typesetting/csp/constraint-tests.rkt

146 lines
5.6 KiB
Racket

10 years ago
#lang racket
(require "constraint.rkt")
(require rackunit)
(define-simple-check (check-hash-items h1 h2)
(for/and ([(k1 v1) (in-hash h1)])
(equal? (hash-ref h2 k1) v1)))
;; ABC problem:
;; what is the minimum value of
;; ABC
;; -------
;; A+B+C
(define abc-problem (new Problem))
(send abc-problem addVariables '("a" "b" "c") (range 1 10))
(define (test-solution s) (let ([a (hash-ref s "a")]
[b (hash-ref s "b")]
[c (hash-ref s "c")])
(/ (+ (* 100 a) (* 10 b) c) (+ a b c))))
(check-hash-items (argmin test-solution (send abc-problem getSolutions))
#hash(("c" . 9) ("b" . 9) ("a" . 1)))
;; quarter problem:
;; 26 coins, dollars and quarters
;; that add up to $17.
(define quarter-problem (new Problem))
(send quarter-problem addVariables '("dollars" "quarters") (range 1 27))
(send quarter-problem addConstraint (λ(d q) (= 17 (+ d (* 0.25 q)))) '("dollars" "quarters"))
(send quarter-problem addConstraint (λ(d q) (= 26 (+ d q))) '("dollars" "quarters"))
(check-hash-items (send quarter-problem getSolution) '#hash(("dollars" . 14) ("quarters" . 12)))
;; coin problem 2
#|
A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there?
|#
(define nickel-problem (new Problem))
(send nickel-problem addVariables '(nickels dimes quarters) (range 1 34))
(send nickel-problem addConstraint (λ(n d q) (= 33 (+ n d q))) '(nickels dimes quarters))
(send nickel-problem addConstraint (λ(n d q) (= 3.30 (+ (* 0.05 n) (* 0.1 d) (* 0.25 q)))) '(nickels dimes quarters))
(send nickel-problem addConstraint (λ(n q) (= n (* 3 q))) '(nickels quarters))
(send nickel-problem addConstraint (λ(d n) (= n (* 2 d))) '(dimes nickels))
(check-hash-items (send nickel-problem getSolution) #hash((nickels . 18) (quarters . 6) (dimes . 9)))
;; word math
#|
# Assign equal values to equal letters, and different values to
# different letters, in a way that satisfies the following sum:
#
# TWO
# + TWO
# -----
# FOUR
|#
(define two-four-problem (new Problem))
(send two-four-problem addVariables '(t w o f u r) (range 10))
(send two-four-problem addConstraint (new AllDifferentConstraint))
(send two-four-problem addConstraint (λ(t w o) (> (word-value t w o) 99)) '(t w o))
(send two-four-problem addConstraint (λ(f o u r) (> (word-value f o u r) 999)) '(f o u r))
(send two-four-problem addConstraint
(λ (t w o f u r)
(let ([two (word-value t w o)]
[four (word-value f o u r)])
((two . + . two) . = . four))) '(t w o f u r))
(check-equal? (length (send two-four-problem getSolutions)) 7)
(send two-four-problem addConstraint (λ(r) (= r 0)) '(r))
(check-hash-items (send two-four-problem getSolution) #hash((o . 5) (w . 6) (u . 3) (f . 1) (r . 0) (t . 7)))
;; xsum
#|
# Reorganize the following numbers in a way that each line of
# 5 numbers sum to 27.
#
# 1 6
# 2 7
# 3
# 8 4
# 9 5
#
|#
(define xsum-problem (new Problem))
(send xsum-problem addVariables '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 10))
(send xsum-problem addConstraint (λ (l1 l2 l3 l4 x)
(and (< l1 l2 l3 l4)
(= 27 (+ l1 l2 l3 l4 x)))) '(l1 l2 l3 l4 x))
(send xsum-problem addConstraint (λ (r1 r2 r3 r4 x)
(and (< r1 r2 r3 r4)
(= 27 (+ r1 r2 r3 r4 x)))) '(r1 r2 r3 r4 x))
(send xsum-problem addConstraint (new AllDifferentConstraint))
(check-equal? (length (send xsum-problem getSolutions)) 8)
;; send more money problem
#|
# Assign equal values to equal letters, and different values to
# different letters, in a way that satisfies the following sum:
#
# SEND
# + MORE
# ------
# MONEY
|#
(define sm-problem (new Problem))
(send sm-problem addVariables '(s e n d m o r y) (range 10))
(send sm-problem addConstraint (λ(x) (> x 0)) '(s))
(send sm-problem addConstraint (λ(x) (> x 0)) '(m))
(send sm-problem addConstraint (λ(d e y) (= (modulo (+ d e) 10) y)) '(d e y))
(send sm-problem addConstraint (λ(n d r e y)
(= (modulo (+ (word-value n d) (word-value r e)) 100)
(word-value e y))) '(n d r e y))
(send sm-problem addConstraint (λ(e n d o r y)
(= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y))
(send sm-problem addConstraint (λ(s e n d m o r y) (=
(+ (word-value s e n d)
(word-value m o r e))
(word-value m o n e y))) '(s e n d m o r y))
(send sm-problem addConstraint (new AllDifferentConstraint))
(check-hash-items (send sm-problem getSolution) '#hash((m . 1) (e . 5) (r . 8) (n . 6) (y . 2) (o . 0) (d . 7) (s . 9)))
;; queens problem
(define qp (new Problem))
(define cols (range 8))
(define rows (range 8))
(send qp addVariables cols rows)
(for* ([col1 (in-list cols)] [col2 (in-list cols)] #:when (< col1 col2))
(send qp addConstraint (λ(row1 row2 [col1 col1][col2 col2])
(and
;; test if two cells are on a diagonal
(not (= (abs (- row1 row2)) (abs (- col1 col2))))
;; test if two cells are in same row
(not (= row1 row2)))) (list col1 col2)))
(check-equal? (length (send qp getSolutions)) 92)