commit 2d1e58224d4dd0d8ee91fc711691e470f8cbcd96 parent 5d5383bb748396da6e1d94e3f6e42651e0be1472 Author: Yuval Langer <yuval.langer@gmail.com> Date: Tue, 18 Apr 2023 09:36:44 +0300 Add solution to exercise 3.23. That was something… Diffstat:
19 files changed, 578 insertions(+), 0 deletions(-)
diff --git a/sicp/solutions/3_23/3_23.scm b/sicp/solutions/3_23/3_23.scm @@ -0,0 +1,74 @@ +(define-library (sicp solutions 3_23 3_23) + (import (scheme base)) + (import (scheme write)) + + (import (sicp solutions 3_23 deque-to-list)) + (import (sicp solutions 3_23 empty-deque)) + (import (sicp solutions 3_23 front-delete-deque)) + (import (sicp solutions 3_23 front-deque)) + (import (sicp solutions 3_23 front-insert-deque)) + (import (sicp solutions 3_23 front-ptr)) + (import (sicp solutions 3_23 make-deque)) + (import (sicp solutions 3_23 print-deque)) + (import (sicp solutions 3_23 rear-delete-deque)) + (import (sicp solutions 3_23 rear-deque)) + (import (sicp solutions 3_23 rear-insert-deque)) + + (export + deque->list + empty-deque? + front-delete-deque! + front-deque + front-insert-deque! + make-deque + print-deque + rear-delete-deque! + rear-deque + rear-insert-deque! + ) + + (begin + ;; Just a reminder, the API of the previous exercises: + + ;; (make-queue) + ;; + ;; returns a new queue object. + + ;; (empty-queue? queue) + ;; returns either #t or #f. + + ;; (front-queue queue) + ;; + ;; if queue is empty raises an error or returns the earliest + ;; element inserted still in existence. + + ;; (insert-queue! queue item) + ;; inserts at the extremity. + + ;; (delete-queue! queue) + ;; + ;; if queue is empty raises an error or deletes that earliest item + ;; inserted still in existence. + + ;; We'll implement: + + ;; Public: + ;; + ;; (make-deque) + ;; (empty-deque? deque) + ;; (front-deque deque) + ;; (rear-deque deque) + ;; (front-insert-deque! deque item) + ;; (rear-insert-deque! deque item) + ;; (front-delete-deque! deque item) + ;; (rear-delete-deque! deque item) + ;; (print-deque deque) + ;; + ;; Private: + ;; + ;; (front-ptr deque) + ;; (rear-ptr deque) + ;; (set-front-ptr! deque item) + ;; (set-rear-ptr! deque item) + ;; (deque->list deque) +)) diff --git a/sicp/solutions/3_23/deque-to-list.scm b/sicp/solutions/3_23/deque-to-list.scm @@ -0,0 +1,11 @@ +(define-library (sicp solutions 3_23 deque-to-list) + (import (scheme base)) + + (import (sicp solutions 3_23 front-ptr)) + (import (prefix (sicp solutions 3_23 doubly-linked-list) dll:)) + + (export deque->list) + + (begin + (define (deque->list deque) + (dll:doubly-linked-list->list (front-ptr deque))))) diff --git a/sicp/solutions/3_23/doubly-linked-list.scm b/sicp/solutions/3_23/doubly-linked-list.scm @@ -0,0 +1,83 @@ +(define-library (sicp solutions 3_23 doubly-linked-list) + (import (scheme base)) + (import (scheme write)) + + (import (ice-9 pretty-print)) + + (export + delete-front! + delete-rear! + doubly-linked-list->list + list->doubly-linked-list + link-front + link-item + link-rear + link-up-front-to-rear! + make-link + ) + + (begin + (define (make-link item) + (cons item + (cons '() '()))) + + (define (list->doubly-linked-list l) + (cond + ((null? l) + '()) + (else + (let* ([item (car l)] + [new-link (make-link item)] + [rest-of-list (cdr l)] + [rest-of-doubly-linked-list (list->doubly-linked-list rest-of-list)]) + (link-up-left-to-right! new-link + rest-of-doubly-linked-list))))) + + (define (link-item link) + "Returns LINK's item." + (car link)) + + (define (link-front link) + "Returns the link at the front of LINK." + (cadr link)) + + (define (link-rear link) + "Returns the link at the rear of LINK." + (cddr link)) + + (define (set-front-pointer! link object) + "Set the front pointer of LINK to point at OBJECT." + (set-car! (cdr link) + object)) + + (define (set-rear-pointer! link object) + "Set the rear pointer of LINK to point at OBJECT." + (set-cdr! (cdr link) + object)) + + (define (link-up-front-to-rear! link-1 link-2) + "Set the rear pointer of LINK-1 to point at LINK-2 and the front pointer of LINK-2 to point at LINK-1. Returns LINK-1." + (when (not (null? link-1)) + (set-rear-pointer! link-1 + link-2)) + (when (not (null? link-2)) + (set-front-pointer! link-2 + link-1)) + link-1) + + (define (delete-front! link) + "Set the front pointer of LINK to be '()." + (set-front-pointer! link '())) + + (define (delete-rear! link) + "Set the rear pointer of LINK to be '()." + (set-rear-pointer! link '())) + + + (define (doubly-linked-list->list link) + (cond + ((null? link) + '()) + (else + (cons (link-item link) + (doubly-linked-list->list (link-rear link)))))))) diff --git a/sicp/solutions/3_23/empty-deque.scm b/sicp/solutions/3_23/empty-deque.scm @@ -0,0 +1,11 @@ +(define-library (sicp solutions 3_23 empty-deque) + (import (scheme base)) + + (import (sicp solutions 3_23 front-ptr)) + + (export empty-deque?) + + (begin + (define (empty-deque? deque) + "Returns #t if empty, else #f." + (null? (front-ptr deque))))) diff --git a/sicp/solutions/3_23/front-delete-deque.scm b/sicp/solutions/3_23/front-delete-deque.scm @@ -0,0 +1,29 @@ +(define-library (sicp solutions 3_23 front-delete-deque) + (import (scheme base)) + (import (scheme write)) + + (import (sicp solutions 3_23 empty-deque)) + (import (sicp solutions 3_23 front-ptr)) + (import (sicp solutions 3_23 rear-ptr)) + (import (sicp solutions 3_23 set-front-ptr)) + (import (sicp solutions 3_23 set-rear-ptr)) + (import (prefix (sicp solutions 3_23 doubly-linked-list) dll:)) + + (export front-delete-deque!) + + (begin + (define (front-delete-deque! deque) + "Delete frontmost item of DEQUE if DEQUE is not empty, otherwise raise an error." + + (display (dll:doubly-linked-list->list (front-ptr deque))) (newline) + (cond + ((empty-deque? deque) + (error "FRONT-DELETE-DEQUE! called with an empty deque" deque)) + ((null? (dll:link-rear (front-ptr deque))) ; The front link's rear pointer would point at '() only if it is the only link in the DEQUE. + (set-front-ptr! deque '()) + (set-rear-ptr! deque '())) + (else + (set-front-ptr! deque + (dll:link-rear (front-ptr deque))) + (dll:delete-front! (front-ptr deque)))) + deque))) diff --git a/sicp/solutions/3_23/front-deque.scm b/sicp/solutions/3_23/front-deque.scm @@ -0,0 +1,16 @@ +(define-library (sicp solutions 3_23 front-deque) + (import (scheme base)) + + (import (sicp solutions 3_23 empty-deque)) + (import (sicp solutions 3_23 front-ptr)) + (import (prefix (sicp solutions 3_23 doubly-linked-list) dll:)) + + (export front-deque) + + (begin + (define (front-deque deque) + "Returns the frontmost item if the deque is not empty. +If deque is empty raises an error." + (if (empty-deque? deque) + (error "FRONT-DEQUE called with an empty deque" deque) + (dll:link-item (front-ptr deque)))))) diff --git a/sicp/solutions/3_23/front-insert-deque.scm b/sicp/solutions/3_23/front-insert-deque.scm @@ -0,0 +1,27 @@ +(define-library (sicp solutions 3_23 front-insert-deque) + (import (scheme base)) + + (import (sicp solutions 3_23 empty-deque)) + (import (sicp solutions 3_23 front-ptr)) + (import (sicp solutions 3_23 rear-ptr)) + (import (sicp solutions 3_23 set-front-ptr)) + (import (sicp solutions 3_23 set-rear-ptr)) + (import (prefix (sicp solutions 3_23 doubly-linked-list) dll:)) + + (export front-insert-deque!) + + (begin + (define (front-insert-deque! deque item) + "Insert ITEM to the front of DEQUE and returns the changed DEQUE." + (let ([new-link (dll:make-link item)]) + (cond + ((empty-deque? deque) + (set-front-ptr! deque new-link) + (set-rear-ptr! deque new-link)) + (else + (dll:link-up-front-to-rear! new-link + (front-ptr deque)) + (set-front-ptr! deque + new-link)))) + + deque))) diff --git a/sicp/solutions/3_23/front-ptr.scm b/sicp/solutions/3_23/front-ptr.scm @@ -0,0 +1,5 @@ +(define-library (sicp solutions 3_23 front-ptr) + (import (scheme base)) + (export front-ptr) + (begin + (define (front-ptr deque) (car deque)))) diff --git a/sicp/solutions/3_23/make-deque.scm b/sicp/solutions/3_23/make-deque.scm @@ -0,0 +1,7 @@ +(define-library (sicp solutions 3_23 make-deque) + (import (scheme base)) + (export make-deque) + (begin + (define (make-deque) + "Returns a new deque object." + (cons '() '())))) diff --git a/sicp/solutions/3_23/one-item-in-deque.scm b/sicp/solutions/3_23/one-item-in-deque.scm @@ -0,0 +1,11 @@ +(define-library (sicp solutions 3_23 one-item-in-deque) + (import (scheme base)) + + (import (sicp solutions 3_23 front-ptr)) + + (export one-item-in-deque?) + + (begin + (define (one-item-in-deque? deque) + "Returns #t if there is one item in QUEUE, else returns #f. Raises an error if QUEUE is empty." + ))) diff --git a/sicp/solutions/3_23/print-deque.scm b/sicp/solutions/3_23/print-deque.scm @@ -0,0 +1,14 @@ +(define-library (sicp solutions 3_23 print-deque) + (import (scheme base)) + (import (scheme write)) + + (import (sicp solutions 3_23 deque-to-list)) + + (export print-deque) + + (begin + (define (print-deque deque . port) + (if (null? port) + (display (deque->list deque)) + (display (deque->list deque) + (car port)))))) diff --git a/sicp/solutions/3_23/rear-delete-deque.scm b/sicp/solutions/3_23/rear-delete-deque.scm @@ -0,0 +1,27 @@ +(define-library (sicp solutions 3_23 rear-delete-deque) + (import (scheme base)) + + (import (sicp solutions 3_23 empty-deque)) + (import (sicp solutions 3_23 front-ptr)) + (import (sicp solutions 3_23 rear-ptr)) + (import (sicp solutions 3_23 set-front-ptr)) + (import (sicp solutions 3_23 set-rear-ptr)) + (import (prefix (sicp solutions 3_23 doubly-linked-list) dll:)) + + (export rear-delete-deque!) + + (begin + (define (rear-delete-deque! deque) + "Delete rearmost item of DEQUE if DEQUE is not empty, otherwise raise an error." + (cond + ((empty-deque? deque) + (error "REAR-DELETE-DEQUE! called with an empty deque" deque)) + ((eq? (dll:link-rear (front-ptr deque)) + '()) ; The front link's rear pointer would point at '() only if it is the only link in the DEQUE. + (set-front-ptr! deque '()) + (set-rear-ptr! deque '())) + (else + (set-rear-ptr! deque + (dll:link-front (rear-ptr deque))) + (dll:delete-rear! (rear-ptr deque)))) + deque))) diff --git a/sicp/solutions/3_23/rear-deque.scm b/sicp/solutions/3_23/rear-deque.scm @@ -0,0 +1,19 @@ +(define-library (sicp solutions 3_23 rear-deque) + (import (scheme base)) + + (import (sicp solutions 3_23 empty-deque)) + (import (sicp solutions 3_23 rear-ptr)) + (import (prefix (sicp solutions 3_23 doubly-linked-list) dll:)) + + + (export rear-deque) + + (begin + (define (rear-deque deque) + "Returns the rearmost item if the deque is not empty. +If deque is empty raises an error." + (cond + ((empty-deque? deque) + (error "REAR-DEQUE called with an empty deque" deque)) + (else + (dll:link-item (rear-ptr deque))))))) diff --git a/sicp/solutions/3_23/rear-insert-deque.scm b/sicp/solutions/3_23/rear-insert-deque.scm @@ -0,0 +1,29 @@ +(define-library (sicp solutions 3_23 rear-insert-deque) + (import (scheme base)) + (import (scheme write)) + + (import (sicp solutions 3_23 empty-deque)) + (import (sicp solutions 3_23 front-ptr)) + (import (sicp solutions 3_23 rear-ptr)) + (import (sicp solutions 3_23 set-front-ptr)) + (import (sicp solutions 3_23 set-rear-ptr)) + (import (prefix (sicp solutions 3_23 doubly-linked-list) dll:)) + + (export rear-insert-deque!) + + (begin + (define (rear-insert-deque! deque item) + "Insert ITEM to the rear of DEQUE and returns the changed DEQUE." + (display (dll:doubly-linked-list->list (front-ptr deque))) (newline) + (let ([new-link (dll:make-link item)]) + (cond + ((empty-deque? deque) + (set-front-ptr! deque new-link) + (set-rear-ptr! deque new-link)) + (else + (dll:link-up-front-to-rear! (rear-ptr deque) + new-link) + (set-rear-ptr! deque + new-link)))) + + deque))) diff --git a/sicp/solutions/3_23/rear-ptr.scm b/sicp/solutions/3_23/rear-ptr.scm @@ -0,0 +1,5 @@ +(define-library (sicp solutions 3_23 rear-ptr) + (import (scheme base)) + (export rear-ptr) + (begin + (define (rear-ptr deque) (cdr deque)))) diff --git a/sicp/solutions/3_23/set-front-ptr.scm b/sicp/solutions/3_23/set-front-ptr.scm @@ -0,0 +1,8 @@ +(define-library (sicp solutions 3_23 set-front-ptr) + (import (scheme base)) + + (export set-front-ptr!) + + (begin + (define (set-front-ptr! deque item) + (set-car! deque item)))) diff --git a/sicp/solutions/3_23/set-rear-ptr.scm b/sicp/solutions/3_23/set-rear-ptr.scm @@ -0,0 +1,8 @@ +(define-library (sicp solutions 3_23 set-rear-ptr) + (import (scheme base)) + + (export set-rear-ptr!) + + (begin + (define (set-rear-ptr! deque item) + (set-cdr! deque item)))) diff --git a/sicp/tests/3_23.scm b/sicp/tests/3_23.scm @@ -0,0 +1,173 @@ +(define-library (sicp tests 3_23) + (import (scheme base)) + (import (scheme write)) + + (import (srfi :64)) + + (import (sicp solutions 3_23 3_23)) + + (begin + (test-begin "3.23") + + (define (test-equal-print-deque string-ratsui deque-matsui) + (define string-port (open-output-string)) + + (print-deque deque-matsui string-port) + + (print-deque deque-matsui) (newline) + + (define string-matsui + (get-output-string string-port)) + + (test-equal string-ratsui string-matsui)) + + (define q1 (make-deque)) + (test-equal-print-deque "()" q1) + (test-error (front-deque q1)) + (test-error (rear-deque q1)) + + (rear-insert-deque! q1 1) + (test-equal-print-deque "(1)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (rear-insert-deque! q1 2) + (test-equal-print-deque "(1 2)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 2 + (rear-deque q1)) + + (rear-insert-deque! q1 3) + (test-equal-print-deque "(1 2 3)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 3 + (rear-deque q1)) + + (rear-insert-deque! q1 4) + (test-equal-print-deque "(1 2 3 4)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + + (front-delete-deque! q1) + (test-equal-print-deque "(2 3 4)" q1) + (test-equal + 2 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + + (front-delete-deque! q1) + (test-equal-print-deque "(3 4)" q1) + (test-equal + 3 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + + (front-delete-deque! q1) + (test-equal-print-deque "(4)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + + + (front-delete-deque! q1) + (test-equal-print-deque "()" q1) + (test-error + (front-deque q1)) + (test-error + (rear-deque q1)) + + (front-insert-deque! q1 1) + (test-equal-print-deque "(1)" q1) + (test-equal + 1 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (front-insert-deque! q1 2) + (test-equal-print-deque "(2 1)" q1) + (test-equal + 2 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (front-insert-deque! q1 3) + (test-equal-print-deque "(3 2 1)" q1) + (test-equal + 3 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (front-insert-deque! q1 4) + (test-equal-print-deque "(4 3 2 1)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 1 + (rear-deque q1)) + + (rear-delete-deque! q1) + (test-equal-print-deque "(4 3 2)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 2 + (rear-deque q1)) + + (rear-delete-deque! q1) + (test-equal-print-deque "(4 3)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 3 + (rear-deque q1)) + + (rear-delete-deque! q1) + (test-equal-print-deque "(4)" q1) + (test-equal + 4 + (front-deque q1)) + (test-equal + 4 + (rear-deque q1)) + + (rear-delete-deque! q1) + (test-equal-print-deque "()" q1) + (test-error (front-deque q1)) + (test-error (rear-deque q1)) + + + (test-end "3.23"))) diff --git a/sicp/tests/doubly-linked-list.scm b/sicp/tests/doubly-linked-list.scm @@ -0,0 +1,21 @@ +(define-library (sicp tests doubly-linked-list) + (import (scheme base)) + + (import (srfi :64)) + + (import (prefix (sicp solutions 3_23 doubly-linked-list) dll:)) + + (begin + (test-begin "doubly-linked-list") + + (define l1 (dll:make-link 1)) + + (test-equal + '(1) + (dll:doubly-linked-list->list l1)) + + (test-equal + '(1 2 3) + (dll:doubly-linked-list->list (dll:list->doubly-linked-list '(1 2 3)))) + + (test-end "doubly-linked-list")))