Skip to content

Instantly share code, notes, and snippets.

@mohanrajendran
Created November 15, 2015 20:13
Show Gist options
  • Save mohanrajendran/fcd8e2d8d73fa7cc2b89 to your computer and use it in GitHub Desktop.
Save mohanrajendran/fcd8e2d8d73fa7cc2b89 to your computer and use it in GitHub Desktop.
SICP Working Code
#lang planet neil/sicp
(define (append x y)
(if (null? x)
y
(cons (car x) (append (cdr x) y))))
(define (last-pair x)
(if (null? (cdr x))
x
(last-pair (cdr x))))
(define (append! x y)
(set-cdr! (last-pair x) y)
x)
(define (make-cycle x)
(set-cdr! (last-pair x) x)
x)
(define (mystery x)
(define (loop x y)
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x))))
(loop x '()))
(define (set-to-wow! x)
(set-car! (car x) 'wow)
x)
(define (count-pairs x)
(if (not (pair? x))
0
(+ (count-pairs (car x))
(count-pairs (cdr x))
1)))
(define w '(a b c))
(define x1 (cons 'a 'b))
(define x2 (cons x1 'c))
(define x (cons x1 x2))
(define y1 (cons 'a 'b))
(define y2 (cons y1 y1))
(define y (cons y2 y2))
(define z (make-cycle '(a b c)))
(define (count-pairs x)
(define encountered '())
(define (count-unique-pairs x)
(if (and (pair? x)
(not (memq x encountered)))
(begin (set! encountered (cons x encountered))
(+ (count-unique-pairs (car x))
(count-unique-pairs (cdr x))
1))
0))
(count-unique-pairs x))
(define (has-cycle-e? x)
(define encountered '())
(define (check-if-seen x)
(cond ((not (pair? x)) #f)
((memq x encountered) #t)
(else (begin (set! encountered (cons x encountered))
(check-if-seen (cdr x))))))
(check-if-seen x))
(define (has-cycle? x)
(define (safe-cdr x)
(if (pair? x)
(cdr x)
'()))
(define (safe-cddr x)
(safe-cdr (safe-cdr x)))
(define (advance-pointer t h)
(cond ((null? h) #f)
((eq? t h) #t)
(else (advance-pointer
(safe-cdr t)
(safe-cddr h)))))
(advance-pointer x (safe-cdr x)))
(define (cons x y)
(define (set-x! v) (set! x v))
(define (set-y! v) (set! y v))
(define (dispatch m)
(cond ((eq? m 'car) x)
((eq? m 'cdr) y)
((eq? m 'set-car!) set-x!)
((eq? m 'set-cdr!) set-y!)
(else (error "Undefined
operation: CONS" m))))
dispatch)
(define (car z) (z 'car))
(define (cdr z) (z 'cdr))
(define (set-car! z new-value)
((z 'set-car!) new-value)
z)
(define (set-cdr! z new-value)
((z 'set-cdr!) new-value)
z)
# lang planet neil/sicp
(define (make-queue) (cons '() '()))
(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 (front-queue queue)
(if (empty-queue? queue)
(error "FRONT called with an empty queue" queue)
(car (front-ptr queue))))
(define (empty-queue? queue)
(null? (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 (print-queue queue)
(newline)
(display (front-ptr queue)))
(define (make-queue)
(let ((front-ptr '())
(rear-ptr '()))
(define (print-queue)
(newline)
(display front-ptr))
(define (empty-queue?)
(null? front-ptr))
(define (front-queue)
(if (empty-queue?)
(error "FRONT called with an empty queue" front-ptr)
(car front-ptr)))
(define (insert-queue! item)
(let ((new-pair (cons item '())))
(cond ((empty-queue?)
(set! front-ptr new-pair)
(set! rear-ptr new-pair))
(else
(set-cdr! 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 (cdr front-ptr)))))
(define (dispatch m)
(cond ((eq? m 'insert-queue!) insert-queue!)
((eq? m 'delete-queue!) (delete-queue!))
((eq? m 'front-queue) (front-queue))
((eq? m 'empty-queue?) (empty-queue?))
((eq? m 'print-queue) (print-queue))
(else (error "Undefined operation: MAKE-QUEUE" m))))
dispatch))
(define (print-queue queue) (queue 'print-queue))
(define (front-queue queue) (queue 'front-queue))
(define (empty-queue? queue) (queue 'empty-queue?))
(define (insert-queue! queue item)
((queue 'insert-queue!) item)
(print-queue queue))
(define (delete-queue! queue)
(queue 'delete-queue!)
(print-queue queue))
(define (make-deque) (cons '() '()))
(define (front-ptr deque) (car deque))
(define (rear-ptr deque) (cdr deque))
(define (set-front-ptr! deque item)
(set-car! deque item))
(define (set-rear-ptr! deque item)
(set-cdr! deque item))
(define (make-node value) (cons value (cons '() '())))
(define (get-value node) (car node))
(define (next-ptr node) (cadr node))
(define (prev-ptr node) (cddr node))
(define (set-next-ptr! node next-node)
(set-car! (cdr node) next-node))
(define (set-prev-ptr! node prev-node)
(set-cdr! (cdr node) prev-node))
(define (empty-deque? deque)
(and (null? (front-ptr deque))
(null? (rear-ptr deque))))
(define (front-deque deque)
(if (empty-deque? deque)
(error "FRONT called with an empty deque" deque)
(get-value (front-ptr deque))))
(define (rear-deque deque)
(if (empty-deque? deque)
(error "REAR called with an empty deque" deque)
(get-value (rear-ptr deque))))
(define (front-insert-deque! deque item)
(let ((new-node (make-node item)))
(cond ((empty-deque? deque)
(set-front-ptr! deque new-node)
(set-rear-ptr! deque new-node))
(else (let ((front-node (front-ptr deque)))
(set-next-ptr! new-node front-node)
(set-prev-ptr! front-node new-node)
(set-front-ptr! deque new-node))))))
(define (rear-insert-deque! deque item)
(let ((new-node (make-node item)))
(cond ((empty-deque? deque)
(set-front-ptr! deque new-node)
(set-rear-ptr! deque new-node))
(else (let ((rear-node (rear-ptr deque)))
(set-prev-ptr! new-node rear-node)
(set-next-ptr! rear-node new-node)
(set-rear-ptr! deque new-node))))))
(define (front-delete-deque! deque)
(cond ((empty-deque? deque)
(error "DELETE! called with an empty deque" deque))
(else ())
))
(define (front-delete-deque! deque)
(cond ((empty-deque? deque)
(error "DELETE! called with an empty deque" deque))
((eq? (front-ptr deque) (rear-ptr deque))
(set-front-ptr! deque '())
(set-rear-ptr! deque '()))
(else (set-front-ptr! deque (next-ptr (front-ptr deque))))))
(define (rear-delete-deque! deque)
(cond ((empty-deque? deque)
(error "DELETE! called with an empty deque" deque))
((eq? (front-ptr deque) (rear-ptr deque))
(set-front-ptr! deque '())
(set-rear-ptr! deque '()))
(else (set-rear-ptr! deque (prev-ptr (rear-ptr deque))))))
(define (print-deque deque)
(define (printable-deque ptr)
(cond ((null? ptr) '())
((eq? ptr (rear-ptr deque))
(cons (get-value ptr) '()))
(else (cons (get-value ptr)
(printable-deque (next-ptr ptr))))))
(newline)
(display (printable-deque (front-ptr deque))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment