From: Ramakrishnan Muthukrishnan Date: Sat, 12 Feb 2011 09:12:07 +0000 (+0530) Subject: solutions to 3.21 and 3.22 X-Git-Url: https://git.rkrishnan.org/specifications/%5B/%5D%20/flags/frontends/FTP-and-SFTP.txt?a=commitdiff_plain;h=e0a0801a6c10193de5056b1d4fffaf8b1692d6b0;p=sicp.git solutions to 3.21 and 3.22 --- diff --git a/src/sicp/ex3_21.rkt b/src/sicp/ex3_21.rkt new file mode 100644 index 0000000..9bff4b6 --- /dev/null +++ b/src/sicp/ex3_21.rkt @@ -0,0 +1,49 @@ +#lang r5rs + +(define error display) + +(define (front-ptr queue) (car queue)) +(define (rear-ptr queue) (cdr queue)) +(define (set-front-ptr! queue item) (set-car! queue item)) +(define (set-rear-ptr! queue item) (set-cdr! queue item)) + +(define (empty-queue? queue) (null? (front-ptr queue))) +(define (make-queue) (cons '() '())) +(define (front-queue queue) + (if (empty-queue? queue) + (error "FRONT called with an empty queue" queue) + (car (front-ptr queue)))) +(define (insert-queue! queue item) + (let ((new-pair (cons item '()))) + (cond + ((empty-queue? queue) + (set-front-ptr! queue new-pair) + (set-rear-ptr! queue new-pair) + queue) + (else + (set-cdr! (rear-ptr queue) new-pair) + (set-rear-ptr! queue new-pair) + queue)))) +(define (delete-queue! queue) + (cond + ((empty-queue? queue) + (error "DELETE! called on an empty queue" queue)) + (else + (set-front-ptr! queue (cdr (front-ptr queue))) + queue))) + +(define (print-queue queue) + (define (copy-queue q1) + (let ((q2 (make-queue))) + (set-front-ptr! q2 (front-ptr q1)) + (set-rear-ptr! q2 (rear-ptr q1)) + q2)) + (let ((q (copy-queue queue))) + (if (not (empty-queue? q)) + (begin + (display (front-queue q)) + (display " ") + (print-queue (delete-queue! q)))))) + + + \ No newline at end of file diff --git a/src/sicp/ex3_22.rkt b/src/sicp/ex3_22.rkt new file mode 100644 index 0000000..d922e4b --- /dev/null +++ b/src/sicp/ex3_22.rkt @@ -0,0 +1,59 @@ +#lang r5rs + +(define error display) +(define (make-queue) + (let ((front-ptr '()) + (rear-ptr '())) + (define (set-front-ptr! queue item) + (set! front-ptr item)) + (define (set-rear-ptr! queue item) + (set! rear-ptr item)) + (define (empty-queue? queue) + (null? front-ptr)) + (define (front-queue queue) + (if (empty-queue? queue) + (error "FRONT called with an empty queue" queue) + (car front-ptr))) + (define (insert-queue! queue item) + (let ((new-pair (cons item '()))) + (cond ((empty-queue? queue) + (set-front-ptr! queue new-pair) + (set-rear-ptr! queue new-pair) + front-ptr) + (else + (set-cdr! rear-ptr new-pair) + (set-rear-ptr! queue new-pair) + front-ptr)))) + (define (delete-queue! queue) + (cond ((empty-queue? queue) + (error "DELETE! called with an empty queue" queue)) + (else + (set-front-ptr! queue (cdr front-ptr)) + front-ptr))) + (define (dispatch m) + (cond + ((eq? m 'insert-queue!) + (lambda (queue item) + (insert-queue! queue item))) + ((eq? m 'delete-queue!) + (lambda (queue) + (delete-queue! queue))) + ((eq? m 'empty-queue?) + (lambda (queue) + (empty-queue? queue))) + ((eq? m 'front-queue) + (lambda (queue) + (front-queue queue))))) + dispatch)) + +(define (empty-queue? queue) + ((queue 'empty-queue?) queue)) + +(define (front-queue queue) + ((queue 'front-queue) queue)) + +(define (insert-queue! queue item) + ((queue 'insert-queue!) queue item)) + +(define (delete-queue! queue) + ((queue 'delete-queue!) queue))