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/test.rkt

163 lines
5.2 KiB
Racket

6 years ago
#lang at-exp racket
6 years ago
(require "csp.rkt" rackunit)
6 years ago
(define demo (make-csp))
(add-vars! demo '(t w) (range 7))
(add-var! demo 'o '(2 6 7))
6 years ago
6 years ago
(define (sum-three t w o) (= 3 (+ t w o)))
(add-constraint! demo sum-three '(t w o))
(add-constraint! demo alldiff '(t w o))
(add-constraint! demo < '(t w o))
6 years ago
6 years ago
(check-equal? (time (solve demo)) ($csp (list ($var 't '(0)) ($var 'w '(1)) ($var 'o '(2))) '()))
6 years ago
6 years ago
;; TWO + TWO = FOUR
6 years ago
(define ttf (make-csp))
6 years ago
(add-vars! ttf '(t w o f u r) (reverse (range 10)))
6 years ago
(define (word-value . xs)
(let ([xs (reverse xs)])
(for/sum ([i (in-range (length xs))])
6 years ago
(* (list-ref xs i) (expt 10 i)))))
6 years ago
6 years ago
(add-constraint! ttf alldiff '(t w o f u r))
6 years ago
(add-constraint! ttf (λ (t w o f u r) (= (+ (word-value t w o) (word-value t w o))
(word-value f o u r))) '(t w o f u r))
(add-constraint! ttf positive? '(t))
6 years ago
(add-constraint! ttf positive? '(f))
6 years ago
6 years ago
(define ttf-solution (time (solve ttf)))
6 years ago
(check-equal? ttf-solution
($csp
(list
6 years ago
($var 't '(9))
($var 'w '(3))
($var 'o '(8))
6 years ago
($var 'f '(1))
6 years ago
($var 'u '(7))
($var 'r '(6)))
6 years ago
'()))
(define (ttf-print csp)
(format "~a~a~a + ~a~a~a = ~a~a~a~a" ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 'f) ($csp-ref csp 'o) ($csp-ref csp 'u) ($csp-ref csp 'r)))
6 years ago
(check-equal? (time (solve ttf-solution ttf-print)) "938 + 938 = 1876")
6 years ago
;; ABC problem:
;; what is the minimum value of
;; ABC
;; -------
;; A+B+C
(define abc (make-csp))
6 years ago
(add-vars! abc '(a b c) (range 1 10))
6 years ago
(define (solution-score sol)
(let ([a ($csp-ref sol 'a)]
[b ($csp-ref sol 'b)]
[c ($csp-ref sol 'c)])
6 years ago
(/ (+ (* 100 a) (* 10 b) c) (+ a b c))))
6 years ago
6 years ago
(define abc-sols (time (solve* abc)))
6 years ago
(check-equal? (* 9 9 9) (length abc-sols))
6 years ago
(check-equal?
6 years ago
(argmin solution-score abc-sols)
6 years ago
($csp (list ($var 'a '(1)) ($var 'b '(9)) ($var 'c '(9))) '()))
6 years ago
;; quarter problem:
;; 26 dollars and quarters
;; that add up to $17.
(define quarter-problem (make-csp))
(add-vars! quarter-problem '(dollars quarters) (range 26))
(add-constraint! quarter-problem (λ (d q) (= 26 (+ d q))) '(dollars quarters))
(add-constraint! quarter-problem (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters))
6 years ago
(check-equal? (time (solve quarter-problem))
($csp (list ($var 'dollars '(14)) ($var 'quarters '(12))) '()))
6 years ago
;; nickel problem
#|
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 ndq-problem (make-csp))
(add-vars! ndq-problem '(n d q) (range 33))
(add-constraint! ndq-problem (λ (n d q) (= 33 (+ n d q))) '(n d q))
(add-constraint! ndq-problem (λ (n d q) (= 330 (+ (* n 5) (* d 10) (* q 25)))) '(n d q))
(add-constraint! ndq-problem (λ (n q) (= (* 3 q) n)) '(n q))
(add-constraint! ndq-problem (λ (d n) (= (* 2 d) n)) '(d n))
6 years ago
(check-equal? (time (solve ndq-problem))
($csp (list ($var 'n '(18)) ($var 'd '(9)) ($var 'q '(6))) '()))
6 years ago
;; 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 (make-csp))
6 years ago
(add-vars! xsum-problem '(l1 l2 l3 l4 r1 r2 r3 r4 x) (λ () (shuffle (range 1 10)))
6 years ago
(add-constraint! xsum-problem < '(l1 l2 l3 l4))
(add-constraint! xsum-problem < '(r1 r2 r3 r4))
(add-constraint! xsum-problem (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x))
(add-constraint! xsum-problem (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x))
6 years ago
(add-constraint! xsum-problem alldiff '(l1 l2 l3 l4 r1 r2 r3 r4 x))
;; todo: too slow
6 years ago
#;(check-equal? (length (time (solve* xsum-problem))) 8)
6 years ago
;; 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 smm (make-csp))
(add-vars! smm '(s e n d m o r y) (range 10))
(add-constraint! smm positive? '(s))
(add-constraint! smm positive? '(m))
(add-constraint! smm (λ (s e n d m o r y)
(= (+ (word-value s e n d) (word-value m o r e))
6 years ago
(word-value m o n e y))) '(s e n d m o r y))
6 years ago
(add-constraint! smm alldiff '(s e n d m o r y))
;; todo: too slow
;(solve smm)
;; queens problem
;; place queens on chessboard so they do not intersect
(define queens-problem (make-csp))
(define queens '(q0 q1 q2 q3 q4 q5 q6 q7))
(define rows (range 8))
(add-vars! queens-problem queens rows)
(for* ([(qa qa-col) (in-indexed queens)]
[(qb qb-col) (in-indexed queens)]
#:when (< qa-col qb-col))
6 years ago
(add-constraint! queens-problem
(λ (qa-row qb-row)
(and
(not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal?
(not (= qa-row qb-row)))) ; same row?
(list qa qb)))
6 years ago
(check-equal? 92 (length (solve* queens-problem)))