From: Ramakrishnan Muthukrishnan Date: Fri, 26 Jul 2013 08:25:37 +0000 (+0530) Subject: WIP X-Git-Url: https://git.rkrishnan.org/pf/content/en/seg/bcase/flags/something?a=commitdiff_plain;h=273f2bd230187a3164803ac32d9b5734d0123ad0;p=sicp.git WIP --- diff --git a/src/sicp/logic-puzzles.rkt b/src/sicp/logic-puzzles.rkt new file mode 100644 index 0000000..52a5f48 --- /dev/null +++ b/src/sicp/logic-puzzles.rkt @@ -0,0 +1,26 @@ +#lang racket + +(require "amb-eli.rkt") +(require "distinct.rkt") + +(define (multiple-dwelling) + (let [(baker (amb 1 2 3 4 5)) + (cooper (amb 1 2 3 4 5)) + (fletcher (amb 1 2 3 4 5)) + (miller (amb 1 2 3 4 5)) + (smith (amb 1 2 3 4 5))] + (assert (distinct? (list baker cooper fletcher miller smith))) + (assert (not (= baker 5))) + (assert (not (= cooper 1))) + (assert (not (= fletcher 5))) + (assert (not (= fletcher 1))) + (assert (> miller cooper)) + (assert (not (= (abs (- smith fletcher)) 1))) + (assert (not (= (abs (- fletcher cooper)) 1))) + (list (list 'baker baker) + (list 'cooper cooper) + (list 'fletcher fletcher) + (list 'miller miller) + (list 'smith smith)))) + +(multiple-dwelling) \ No newline at end of file diff --git a/src/sicp/sudoku.rkt b/src/sicp/sudoku.rkt new file mode 100644 index 0000000..88dc926 --- /dev/null +++ b/src/sicp/sudoku.rkt @@ -0,0 +1,61 @@ +#lang racket + +(require "amb-eli.rkt" + "distinct.rkt") + +(define (positions size) + (for*/list ([x (in-range 1 (+ size 1))] + [y (in-range 1 (+ size 1))]) + (list x y))) + +;; board is represented as list of lists +;; + +(define (sudoku board) + (let ([size (length board)]) + (let ([new-board (amb-board board)]) + (for ([r new-board]) + (assert (distinct? r))) + (for ([c (apply map list new-board)]) + (assert (distinct? c))) + (let ([ss (segments size)]) + (for ([s ss]) + (assert (distinct? s))) + new-board)))) + + +(define (amb-board board) + (cond [(empty? board) empty] + [else + (let ([row (first board)]) + (cons (for/list ([r row]) + (if (eq? r '?) + (amb-list (set->list (set-subtract (set 1 2 3 4 5 6 7 8 9) (list->set row)))) + r)) + (amb-board (rest board))))])) + +(define (segments board) + (let ([size (length board)]) + (let ([s (sqrt size)]) + (for*/list ([i (in-range 0 size s)] + [j (in-range 0 size s)]) + (for*/list ([x (in-range i (+ i s))] + [y (in-range j (+ j s))]) + (list-ref (list-ref board x) y)))))) + + + +#| + +((? ? 8 ? ? ? 1 5 ?) + (? ? ? ? ? 1 8 ? ?) + (3 ? 5 4 ? ? ? ? 9) + (5 ? ? ? ? 9 ? ? ?) + (? 9 ? 2 3 4 ? 7 ?) + (? ? ? 1 ? ? ? ? 8) + (4 ? ? ? ? 5 9 ? 1) + (? ? 6 7 ? ? ? ? ?) + (? 5 3 ? ? ? 2 ? ?)) + +|# +