diff options
Diffstat (limited to 'coding-exercises/3')
| -rw-r--r-- | coding-exercises/3/12.rkt | 75 | ||||
| -rw-r--r-- | coding-exercises/3/21.rkt | 83 |
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 |
