save point

2 files changed, 158 insertions, 0 deletions

diff --git a/coding-exercises/3/12.rkt b/coding-exercises/3/12.rkt
new file mode 100644
index 0000000..902cc12
--- /dev/null
+++ b/coding-exercises/3/12.rkt
@@ -0,0 +1,75 @@
+#lang racket
+;; 12
+(require compatibility/mlist)
+(define (last-pair x)
+  (if (null? (mcdr x))
+    x
+    (last-pair (mcdr x))))
+(define x (mlist 'a 'b))
+(define y (mlist 'c 'd))
+(define z (mappend x y))
+x
+(define w (mappend! x y))
+x
+
+;; 13
+(define (make-cycle x)
+  (set-mcdr! (last-pair x) x)
+  x)
+(define zp (make-cycle (mlist 'a 'b 'c)))
+zp
+;; last-pair would make an infinite loop
+
+;; 14
+;; The procedure reverses the list. And messes up the list that is bound in the global env
+(define v (mlist 'a 'b 'c 'd))
+(define (mystery x)
+  (define (loop x y)
+    (if (null? x)
+      y
+      (let ((temp (mcdr x)))
+        (set-mcdr! x y)
+        (loop temp x))))
+  (loop x '()))
+(define wp (mystery v))
+v
+wp
+
+;; 15
+;; 16
+;; 17
+(define (make-pair-counter)
+  (define counted (list))
+  (define (count-pairs x)
+    (display counted)
+    (if (or (not (pair? x))
+            (memq x counted))
+      0
+      (begin
+        (set! counted (cons x counted))
+        (+ 1
+           (count-pairs (car x))
+           (count-pairs (cdr x))))))
+  count-pairs)
+((make-pair-counter) (list 'a 'b 'c))
+(define bc (list 'b 'c))
+((make-pair-counter) (cons bc bc))
+((make-pair-counter) (cons bc (cdr bc)))
+(define c (list 'c))
+(define b (cons c c))
+((make-pair-counter) (cons b b))
+
+;; 18/19
+;; This is actually only a valid way to check for cycles if the first pair in the list is also the state of the cycle.
+;; A better way would be to check against all memory addresses in the list by hashing or counting.
+(define (cycle? x)
+  (define (iter v items)
+    (cond ((null? items) false)
+          ((eq? v items) true)
+          (else (iter v (mcdr items)))))
+  (iter x (mcdr x)))
+(cycle? (mlist 'a 'b 'c))
+(cycle? (make-cycle (mlist 'a 'b 'c)))
+;; For 19 you need a famous trick with two pointers
+
+;; 20
diff --git a/coding-exercises/3/21.rkt b/coding-exercises/3/21.rkt
new file mode 100644
index 0000000..646a8f7
--- /dev/null
+++ b/coding-exercises/3/21.rkt
@@ -0,0 +1,83 @@
+#lang racket
+(require compatibility/mlist)
+;; queue methods
+(define (front-ptr q) (mcar q))
+(define (rear-ptr q) (mcdr q))
+(define (set-front-ptr! q v) (set-mcar! q v))
+(define (set-rear-ptr! q v) (set-mcdr! q v))
+(define (empty-queue? q) (null? (front-ptr q)))
+(define (make-queue) (mcons '() '()))
+(define (front-queue q)
+  (if (empty-queue? q)
+    (error "FRONT called on empty queue" q)
+    (mcar (front-ptr q))))
+(define (insert-queue! q item)
+  (let ((new-item (mlist item)))
+    (cond ((empty-queue? q)
+           (set-front-ptr! q new-item)
+           (set-rear-ptr! q new-item)
+           q)
+          (else
+            (set-mcdr! (rear-ptr q) new-item)
+            (set-rear-ptr! q new-item)
+            q))))
+(define (delete-queue! q)
+  (cond ((empty-queue? q)
+         (error "DELETE! called with an empty queue" q))
+        (else
+          (set-front-ptr! q (mcdr (front-ptr q)))
+          q)))
+;; 21
+(define (print-queue q)
+  (front-ptr q))
+(define q1 (make-queue))
+(print-queue (insert-queue! q1 'a))
+(print-queue (insert-queue! q1 'b))
+(print-queue (delete-queue! q1))
+(print-queue (delete-queue! q1))
+;; 22
+(define (make-queue-obj)
+  (let ((front-ptr '())
+        (rear-ptr '()))
+    (define (set-front-ptr! v)
+      (set! front-ptr v))
+    (define (set-rear-ptr! v)
+      (set! rear-ptr v))
+    (define (empty-queue?)
+      (null? front-ptr))
+    (define (front-queue)
+      (mcar front-ptr))
+    (define (insert-queue! item)
+      (let ((new-pair (mlist item)))
+        (cond ((empty-queue?)
+               (set-front-ptr! new-pair)
+               (set-rear-ptr! new-pair))
+              (else (set-mcdr! rear-ptr new-pair)
+                    (set-rear-ptr! new-pair)))))
+    (define (delete-queue!)
+      (cond ((empty-queue?)
+             (error "DELETE! called with an empty queue" front-ptr))
+            (else
+              (set-front-ptr! (mcdr front-ptr)))))
+    (define (dispatch m)
+      (cond ((eq? m 'front-ptr) front-ptr)
+            ((eq? m 'rear-ptr) rear-ptr)
+            ((eq? m 'set-front-ptr!) set-front-ptr!)
+            ((eq? m 'set-rear-ptr!) set-rear-ptr!)
+            ((eq? m 'empty-queue?) empty-queue?)
+            ((eq? m 'front-queue) front-queue)
+            ((eq? m 'insert-queue!) insert-queue!)
+            ((eq? m 'delete-queue!) delete-queue!)
+            ((eq? m 'print-queue) front-ptr)
+            (else (error "Message note defined on queue" m))))
+    dispatch))
+(define qobj (make-queue-obj))
+((qobj 'insert-queue!) 'a)
+(qobj 'print-queue)
+((qobj 'insert-queue!) 'b)
+(qobj 'print-queue)
+((qobj 'insert-queue!) 'c)
+(qobj 'print-queue)
+((qobj 'delete-queue!))
+(qobj 'print-queue)
+;; 23