From 273f2bd230187a3164803ac32d9b5734d0123ad0 Mon Sep 17 00:00:00 2001
From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Fri, 26 Jul 2013 13:55:37 +0530
Subject: [PATCH] WIP

---
 src/sicp/logic-puzzles.rkt | 26 ++++++++++++++++
 src/sicp/sudoku.rkt        | 61 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 87 insertions(+)
 create mode 100644 src/sicp/logic-puzzles.rkt
 create mode 100644 src/sicp/sudoku.rkt

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 ? ?))
+
+|#
+
-- 
2.37.2