Permalink
Browse files

mutable lists, queues and tables

  • Loading branch information...
1 parent d1d61f0 commit f26cbd18ff785c15831a613a19824cce68679f4b @sarabander committed Nov 11, 2011
Showing with 758 additions and 0 deletions.
  1. +54 −0 3.3/3.12.scm
  2. +23 −0 3.3/3.13.scm
  3. +48 −0 3.3/3.14.scm
  4. +81 −0 3.3/3.16.scm
  5. +43 −0 3.3/3.17.scm
  6. +86 −0 3.3/3.19.scm
  7. +52 −0 3.3/3.21.scm
  8. +70 −0 3.3/3.22.scm
  9. +106 −0 3.3/3.23.scm
  10. +48 −0 3.3/3.24.scm
  11. +55 −0 3.3/3.25.scm
  12. +92 −0 3.3/3.26.scm
View
@@ -0,0 +1,54 @@
+
+;; Works in MIT-Scheme
+
+(define (append! x y)
+ (set-cdr! (last-pair x) y)
+ x)
+
+(define x (list 'a 'b))
+(define y (list 'c 'd))
+(define z (append x y))
+z ; '(a b c d)
+
+(cdr x) ; => '(b)
+
+(define w (append! x y))
+
+w ; '(a b c d)
+x ; '(a b c d)
+
+(cdr x) ; => '(b c d)
+
+;; First we have two lists:
+;;
+;; x ╭───┬───╮ ╭───┬───╮ y ╭───┬───╮ ╭───┬───╮
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ╱ │ ────>│ ∘ │ ∘─┼──>│ ∘ │ ╱ │
+;; ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │ │ │
+;; ╭─V─╮ ╭─V─╮ ╭─V─╮ ╭─V─╮
+;; │ a │ │ b │ │ c │ │ d │
+;; ╰───╯ ╰───╯ ╰───╯ ╰───╯
+;;
+;; Normal append creates a new list, leaving x and y unmodified:
+;;
+;; z ╭───┬───╮ ╭───┬───╮ ╭───┬───╮ ╭───┬───╮
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ╱ │
+;; ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │ │ │
+;; ╭─V─╮ ╭─V─╮ ╭─V─╮ ╭─V─╮
+;; │ a │ │ b │ │ c │ │ d │
+;; ╰───╯ ╰───╯ ╰───╯ ╰───╯
+;;
+;; Mutating append! points the last pair of x to y, but leaves y intact:
+
+;; w │ y │
+;; │ │
+;; x ╭──V┬───╮ ╭───┬───╮ ╭──V┬───╮ ╭───┬───╮
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ╱ │
+;; ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │ │ │
+;; ╭─V─╮ ╭─V─╮ ╭─V─╮ ╭─V─╮
+;; │ a │ │ b │ │ c │ │ d │
+;; ╰───╯ ╰───╯ ╰───╯ ╰───╯
+;;
+;; The same structure is also accessible through w.
View
@@ -0,0 +1,23 @@
+
+(define (make-cycle x)
+ (set-cdr! (last-pair x) x)
+ x)
+
+(define z (make-cycle (list 'a 'b 'c)))
+
+(last-pair z)
+;; This goes to infinite loop: there is no last pair, because z is a
+;; cyclical linked list:
+;;
+;; ╭────────────────────────────────╮
+;; │ │
+;; z ╭──V┬───╮ ╭───┬───╮ ╭───┬───╮ │
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼───╯
+;; ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │ │
+;; ╭─V─╮ ╭─V─╮ ╭─V─╮
+;; │ a │ │ b │ │ c │
+;; ╰───╯ ╰───╯ ╰───╯
+;;
+
+;; Evaluation of z produces never-ending sequence: (a b c a b c a b ...
View
@@ -0,0 +1,48 @@
+
+(define (mystery x)
+ (define (loop x y)
+ (if (null? x)
+ y
+ (let ((temp (cdr x)))
+ (set-cdr! x y)
+ (loop temp x))))
+ (loop x '()))
+
+;; Mystery reverses x.
+
+(define v (list 'a 'b 'c 'd))
+
+;;
+;; v ╭───┬───╮ ╭───┬───╮ ╭───┬───╮ ╭───┬───╮
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ╱ │
+;; ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │ │ │
+;; ╭─V─╮ ╭─V─╮ ╭─V─╮ ╭─V─╮
+;; │ a │ │ b │ │ c │ │ d │
+;; ╰───╯ ╰───╯ ╰───╯ ╰───╯
+;;
+
+(define w (mystery v))
+
+;; Diagrams after defining w:
+;;
+;; v ╭───┬───╮ ╭───┬───╮ ╭───┬───╮ ╭───┬───╮
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ╱ │
+;; ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │ │ │
+;; ╭─V─╮ ╭─V─╮ ╭─V─╮ ╭─V─╮
+;; │ a │ │ b │ │ c │ │ d │
+;; ╰───╯ ╰───╯ ╰───╯ ╰───╯
+;;
+;;
+;; w ╭───┬───╮ ╭───┬───╮ ╭───┬───╮ ╭───┬───╮
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ╱ │
+;; ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │ │ │
+;; ╭─V─╮ ╭─V─╮ ╭─V─╮ ╭─V─╮
+;; │ d │ │ c │ │ b │ │ a │
+;; ╰───╯ ╰───╯ ╰───╯ ╰───╯
+;;
+
+v ; '(a b c d)
+w ; '(d c b a)
View
@@ -0,0 +1,81 @@
+
+(define (count-pairs x)
+ (if (not (pair? x))
+ 0
+ (+ (count-pairs (car x))
+ (count-pairs (cdr x))
+ 1)))
+
+(define p (list 'a 'b 'c))
+(count-pairs p) ; 3
+
+;;
+;; p ╭───┬───╮ ╭───┬───╮ ╭───┬───╮
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ ╱ │
+;; ╰─┼─┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │ │
+;; ╭─V─╮ ╭─V─╮ ╭─V─╮
+;; │ a │ │ b │ │ c │
+;; ╰───╯ ╰───╯ ╰───╯
+;;
+
+(define q '(a b c))
+(set-car! q (cddr q))
+(count-pairs q) ; 4
+
+q ;Value 28: ((c) b c)
+;;
+;; ╭────────────────────────╮
+;; │ │
+;; q ╭─┼─┬───╮ ╭───┬───╮ ╭──V┬───╮
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ / │
+;; ╰───┴───╯ ╰─┼─┴───╯ ╰─┼─┴───╯
+;; │ │
+;; ╭─V─╮ ╭─V─╮
+;; │ b │ │ c │
+;; ╰───╯ ╰───╯
+;;
+
+(define r '(a b c))
+(set-car! r (cdr r))
+(set-car! (cdr r) (cddr r))
+(count-pairs r) ; 7
+
+r ;Value 27: (((c) c) (c) c)
+;;
+;; r ╭───┬───╮
+;; ────>│ ∘ │ ∘ │
+;; ╰─┼─┴─┼─╯
+;; │ │
+;; ╭─V─┬─V─╮
+;; │ ∘ │ ∘ │
+;; ╰─┼─┴─┼─╯
+;; │ │
+;; ╭─V─┬─V─╮
+;; │ ∘ │ / │
+;; ╰─┼─┴───╯
+;; │
+;; ╭─V─╮
+;; │ c │
+;; ╰───╯
+;;
+
+;; Any list structure containing a loop would not return. For example:
+(define s '(a b c))
+(set-car! (cdr s) s)
+(count-pairs s) ;Aborting!: maximum recursion depth exceeded
+
+s ;Value 24: (a (a (a (a ...
+(cdr s) ;Value 29: ((a (a (a (a ...
+;;
+;; ╭──────────╮
+;; │ │
+;; s ╭──V┬───╮ ╭─┼─┬───╮ ╭───┬───╮
+;; ────>│ ∘ │ ∘─┼──>│ ∘ │ ∘─┼──>│ ∘ │ / │
+;; ╰─┼─┴───╯ ╰───┴───╯ ╰─┼─┴───╯
+;; │ │
+;; ╭─V─╮ ╭─V─╮
+;; │ a │ │ c │
+;; ╰───╯ ╰───╯
+;;
+
View
@@ -0,0 +1,43 @@
+
+;; First version can't handle cyclic lists
+(define (count-pairs x)
+ (define pairs (make-hash-table))
+ (define (count-pairs-1 x)
+ (if (or (not (pair? x))
+ (hash-table/get pairs x #f))
+ false
+ (begin
+ (hash-table/put! pairs x #t)
+ (count-pairs-1 (car x))
+ (count-pairs-1 (cdr x)))))
+ (count-pairs-1 x)
+ (hash-table/count pairs))
+
+(count-pairs p) ; 3
+(count-pairs q) ; 3
+(count-pairs s) ;Aborting!: maximum recursion depth exceeded
+(count-pairs z) ;Aborting!: maximum recursion depth exceeded
+
+;; Second version processes cyclic lists correctly
+(define (count-pairs lst)
+ (define tracker '())
+ (define (count-pairs-1 x)
+ (if (or (not (pair? x))
+ (> (length (filter (lambda (item)
+ (eq? item x))
+ tracker))
+ 0))
+ false
+ (begin
+ (set! tracker (cons x tracker))
+ (count-pairs-1 (car x))
+ (count-pairs-1 (cdr x)))))
+ (count-pairs-1 lst)
+ (length tracker))
+
+(count-pairs p) ; 3
+(count-pairs q) ; 3
+(count-pairs r) ; 3
+(count-pairs s) ; 3 [cyclic]
+(count-pairs z) ; 4 [cyclic]
+(count-pairs '(1 2 3 4 5)) ; 5
View
@@ -0,0 +1,86 @@
+
+;; If you haven't already encountered this problem,
+;; then now is an excellent opportunity for deep thought.
+;; Resist the temptation to search the literature for a while.
+;; You can independently come up with an elegant and simple
+;; solution if you just relax and close your eyes. Use your
+;; geometric intuition. After the sudden jolt of revelation,
+;; you will be rewarded with joy and happiness by the spirits
+;; living in the computer.
+
+
+;; SPOILER ALERT!
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;; Cyclic? probes for a loop in list structure.
+;; --------------------------------------------
+;; It puts two pointers running down the list,
+;; one starts ahead, and is twice as fast as the other.
+;; Slow pointer advances if switch is turned on.
+;; If there is a cycle, fast one catches slow one,
+;; and they finally point to the same cell.
+
+(define (cyclic? lst)
+ (define (iter switch slow-pointer fast-pointer)
+ (cond ((null? fast-pointer) #f)
+ ((eq? slow-pointer fast-pointer) #t)
+ (else (iter (not switch)
+ (if switch (cdr slow-pointer) slow-pointer)
+ (cdr fast-pointer)))))
+ (iter #t lst (cdr lst)))
+
+
+;; Tests
+(define (make-cycle x)
+ (set-cdr! (last-pair x) x)
+ x)
+
+(define z (make-cycle (list 'a 'b 'c 'd)))
+(define w (append '(g h j) z))
+
+(count-pairs w) ; 7
+
+;; p, q, r and s are defined in 3.16
+
+(cyclic? z) ; true
+(cyclic? w) ; true
+(cyclic? p) ; false
+(cyclic? q) ; false
+(cyclic? r) ; false
+(cyclic? s) ; false (cycles starting from car of a pair are not detected)
+(cyclic? '(1 2 3 1 2 3 1 2 3)) ; false
+
+(define (make-long-list length)
+ (define (iter counter lst)
+ (if (= counter 0)
+ lst
+ (iter (- counter 1) (cons (random 10) lst))))
+ (iter length '()))
+
+(define long1 (make-long-list 1000000))
+(define long1cyc (make-cycle long1)) ; changes long1 in place and makes alias
+(define long2 (make-long-list 200000))
+(define long3 (append long2 long1))
+
+(cyclic? long1) ; true
+(cyclic? long1cyc) ; true
+(cyclic? long2) ; false
+(cyclic? long3) ; true
View
@@ -0,0 +1,52 @@
+
+(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 with an empty queue" queue))
+ (else
+ (set-front-ptr! queue (cdr (front-ptr queue)))
+ queue)))
+
+;; ---------------------------------------------------------
+
+(define q1 (make-queue))
+(insert-queue! q1 'a) ; ((a) a)
+
+(insert-queue! q1 'b) ; ((a b) b)
+
+(delete-queue! q1) ; ((b) b)
+
+(delete-queue! q1) ; (() b)
+
+;; The Scheme printer just prints q1 as ordinary pair. Its car is the list
+;; consisting of the entire queue, and its cdr is the last item of the queue.
+
+;; Assuming the last item of list pointed by front-ptr and the item
+;; pointed by rear-ptr coincide.
+(define (print-queue queue)
+ (front-ptr queue))
+
+(print-queue q1) ; (a b)
+;; after (insert-queue! q1 'b)
Oops, something went wrong.

0 comments on commit f26cbd1

Please sign in to comment.