Warning
This page is located in archive.

Scheme Lecture 1

define, quote, ', if, =, +, -, *, /, null?, car, cdr, c…r, cons, . (dotted pair), append

(define (factorial n)
  (if (= n 0) 
      1
      (* n (factorial (- n 1)))
      )
  )

(define (last-element s)
  (if (null? (cdr s))
      (car s)
      (last-element (cdr s))
      ))

(define (my-append a b)
  (if (null? a)
      b
      (cons (car a) (my-append (cdr a) b))))

(define (evens s)
  (if (null? s) 
      s
      (if (null? (cdr s))
          '()
          (cons (cadr s) (evens (cddr s)))
          )
      )
  )

Scheme Lecture 2

lambda, let, let*, letrec, cond

(define (minimum1 s)
  (if (null? (cdr s))
      (car s)
      (if (< (car s) (minimum1 (cdr s)))
          (car s)
          (minimum1 (cdr s))
          )))
 
(define (minimum2 s)
  (if (null? (cdr s))
      (car s)
      ((lambda (m)
         (if (< (car s) m)
             (car s)
             m
             ))
       (minimum2 (cdr s))
       )))
 
(define (minimum3 s)
  (if (null? (cdr s))
      (car s)
      (let (
            (m (minimum3 (cdr s)))
            )
        (if (< (car s) m)
            (car s)
            m
            ))
      ))

(define (split pivot s)
  (if (null? s) '(() . ())
      (let* (
             (r (split pivot (cdr s)))
             (a (car r))
             (b (cdr r))
             (p (car s))
             )
        (if (<= p pivot)
            (cons (cons p a) b)
            (cons a (cons p b))
            ))))
 
(define (qsort s)
  (cond 
    ((null? s) s)
    ((null? (cdr s)) s)
    (else
     (let* (
            (pivot (car s))
            (r (split pivot (cdr s)))
            (a (car r))
            (b (cdr r))
            (sa (qsort a))
            (sb (qsort b))
            )
       (append sa (cons pivot sb))
       ))))

Scheme Lecture 3

lambda with multiple arguments, list, eval, (interaction-environment), (scheme-report-environment 5), (null-environment 5), apply, display, newline, begin

(define my-list2
  (lambda (s)
    (if (null? s)
        '()
        (cons (car s) (my-list2 (cdr s)))
        )))
(define my-list ; alternative definition of built-in list function
  (lambda s (my-list2 s)))
 
(define my-list3 ; alternative definition of built-in list function
  (lambda s s))
 
(define (my-list4 . s) s) ;  alternative definition of built-in list function

(define (plus . s) ; alternative definition of built-in + function
  (if (null? s) 0
      (+ (car s) (eval (cons 'plus (cdr s)) (interaction-environment)
                       ))      )
  )
 
(define (plus2 . s) ; alternative definition of built-in + function
  (if (null? s) 0
      (+ (car s) (apply plus2 (cdr s)))
      )
  )

(define (my-apply f s) ; alternative definition of simplified built-in apply function 
  ((eval (list 'lambda (list 'h) (cons 'h s)) 
         (null-environment 5)) f))

Scheme Lecture 4

map, call-with-current-continuation, tail call optimization, set!, set-car!, set-cdr!, cyclic data structures

(define (take-first s)
  (if (null? s) s
      (cons (caar s) (take-first (cdr s)))))
 
(define (take-rest s)
  (if (null? s) s
      (cons (cdar s) (take-rest (cdr s)))))
 
(define (my-map f . ls) ; alternative definition of built-in map function
  (if (null? (car ls)) '()
      (cons (apply f (take-first ls))
            (apply my-map f (take-rest ls))
            )))

(define (multiplication s)
  (if (null? (cdr s))
      (car s)
      (* (car s) (multiplication (cdr s)))
      ))
 
(define (mp s exit)
  (if (= (car s) 0)
      (exit 0)
      (if (null? (cdr s))
          (car s)
          (mp (cons (* (car s) (cadr s)) (cddr s)) exit)
          )))
 
(define (multiplication2 s) ; alternative implementation of multiplication function with better time and memory efficiency
  (call-with-current-continuation
   (lambda (e) (mp s e))
   ))
 
 
(define (multiplication3 s) ; alternative and more elegant definition of multiplication2 function with the same computational efficiency
  (call-with-current-continuation
   (lambda (exit) 
     (define (mp s)
       (if (= (car s) 0)
           (exit 0)
           (if (null? (cdr s))
               (car s)
               (mp (cons (* (car s) (cadr s)) (cddr s)))
               )))
 
     (mp s))
   ))

(define (make-cyclic-list! s)
  (define (mcl! x)
    (if (null? (cdr x))
        (set-cdr! x s)
        (mcl! (cdr x))))
  (mcl! s)
  )
 
 
>(define week '(sunday monday tuesday wednesday thursday friday saturday))
 
> week
(sunday monday tuesday wednesday thursday friday saturday)  
 
>(make-cyclic-list! week)
 
> week
#0=(sunday monday tuesday wednesday thursday friday saturday . #0#)

Scheme Lecture 5

quasiquote ( ` and ,), unquote (,), unquote-splicing(,@), delay, force, implementation of functions: cons, car, and cdr only with lambda

(define (der e x)
  (define (d e)
    (der e x))
  (cond 
    ((number? e) 0)
    ((equal? e x) 1)
    ((symbol? e) 0)
    ((equal? (car e) '+) `(+ ,@(map d (cdr e))))
    ((equal? (car e) '-) `(- ,@(map d (cdr e))))
    ((equal? (car e) 'sin) `(* ,(d (cadr e)) (cos ,(cadr e))))
    ((equal? (car e) 'cos) `(* ,(d (cadr e)) (- (sin ,(cadr e)))))
    ((equal? (car e) '*)
     (if (null? (cddr e))
         (d (cadr e))
         (let* (
                (ex1 (cadr e))
                (ex2 `(* ,@(cddr e)))
                (ex1p (d ex1))
                (ex2p (d ex2))
                )
           `(+ (* ,ex1p ,ex2) (* ,ex1 ,ex2p))    
           )))
    ))
 
> (der '(* x y (sin (+ 1 x))) 'x)
(+
 (* 1 (* y (sin (+ 1 x))))
 (*
  x
  (+
   (* 0 (* (sin (+ 1 x))))
   (* y (* (+ 0 1) (cos (+ 1 x))))))) 
 
> (der '(+ x y (sin (+ 1 x))) 'x)
(+ 1 0 (* (+ 0 1) (cos (+ 1 x))))      
 
> ((eval `(lambda (x) ,(der '(+ x y (sin (+ 1 x))) 'x)) (interaction-environment)) 1.5)
0.1988563844530663    

(define (lcons x s)
  (lambda (m)
    (m x s)))
 
(define (lcar s)
  (s (lambda (x y) x)))
 
(define (lcdr s)
  (s (lambda (x y) y)))
 
> (lcar (lcdr (lcdr (lcons 'a (lcons 'b (lcons 'c 'empty))))))
c
> (lcar (lcdr (lcons 1 (lcons 2 (lcons 3 'empty)))))
2

courses/ae4b33flp/scheme.txt · Last modified: 2017/03/09 14:50 by vyskoji1