commit 6dcbc63bf32dcd99902d0c72e7a41df2519dd87d
parent 7329941702c20f3ab94e8a3544a4785cf49f92aa
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sun, 16 Apr 2023 23:43:20 +0300
Add solution to exercise 3.21.
Diffstat:
2 files changed, 139 insertions(+), 0 deletions(-)
diff --git a/sicp/solutions/3_21.scm b/sicp/solutions/3_21.scm
@@ -0,0 +1,65 @@
+(define-library (sicp solutions 3_21)
+ (import (scheme base))
+ (import (scheme write))
+ (export
+ delete-queue!
+ empty-queue?
+ front-queue
+ insert-queue!
+ make-queue
+ print-queue
+ queue->list
+ queue->list
+ )
+
+ (begin
+ (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
+ ;; XXX
+ (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 with an empty queue" queue))
+ (else
+ (set-front-ptr! queue
+ (cdr (front-ptr queue)))
+ queue)))
+
+ (define (queue->list queue)
+ (front-ptr queue))
+
+ (define (print-queue queue . port)
+ (if (null? port)
+ (display (queue->list queue))
+ (display (queue->list queue)
+ (car port))))))
diff --git a/sicp/tests/3_21.scm b/sicp/tests/3_21.scm
@@ -0,0 +1,74 @@
+(define-library (sicp tests 3_21)
+ (import (scheme base))
+ (import (scheme write))
+ (import (srfi :64))
+ (import (sicp solutions 3_21))
+
+ (begin
+ (test-begin "3.21")
+
+ (define (test-equal-print-queue string-ratsui queue-matsui)
+ (define string-port (open-output-string))
+
+ (print-queue queue-matsui string-port)
+
+ (define string-matsui
+ (get-output-string string-port))
+
+ (test-equal string-ratsui string-matsui))
+
+ (define q1 (make-queue))
+ (test-equal '(()) q1)
+ (test-equal-print-queue "()" q1)
+
+ (insert-queue! q1 'a)
+ (test-equal '((a) a) q1)
+ (test-equal-print-queue "(a)" q1)
+
+ (insert-queue! q1 'b)
+ (test-equal '((a b) b) q1)
+ (test-equal-print-queue "(a b)" q1)
+
+ (insert-queue! q1 'c)
+ (test-equal '((a b c) c) q1)
+ (test-equal-print-queue "(a b c)" q1)
+
+ (insert-queue! q1 'd)
+ (test-equal '((a b c d) d) q1)
+ (test-equal-print-queue "(a b c d)" q1)
+
+ (delete-queue! q1)
+ (test-equal '((b c d) d) q1)
+ (test-equal-print-queue "(b c d)" q1)
+
+ (delete-queue! q1)
+ (test-equal '((c d) d) q1)
+ (test-equal-print-queue "(c d)" q1)
+
+ (delete-queue! q1)
+ (test-equal '((d) d) q1)
+ (test-equal-print-queue "(d)" q1)
+
+ (delete-queue! q1)
+ (test-equal '(() d) q1)
+ (test-equal-print-queue "()" q1)
+
+ ;; When one display the queue, without a special procedure, one
+ ;; sees the a tree where the first element is the list of items
+ ;; sorted from first item insert to last item insert to the queue,
+ ;; and the second item is the last item inserted to the queue,
+ ;; whether if the queue is empty or not.
+ ;; ((first-item-inserted second-item-inserted ...) last-item-inserted)
+ ;; or
+ ;; (() last-item-inserted)
+
+ ;; One can see the last item inserted to the queue right after the
+ ;; only item in it is deleted because the rear pointer of the
+ ;; queue does not change which object it points at when
+ ;; delete-queue! is used when there is only one item in the
+ ;; queue. It does not need to change because when the queue is
+ ;; empty and then a new item is inserted, a new (cons item '()) is
+ ;; created, and both the front and rear pointers are pointed at
+ ;; it.
+
+ (test-end "3.21")))
