Scheme Lecture 1

define, quote, ', if, =, +, -, *, /, null?, car, cdr, c…r, cons, append

(define (factorial n)
  (if (= n 0) 1
      (* n (factorial (- n  1)))
      ))
(define (append1 a b)
  (if (null? a)
      b
      (cons (car a) (append1 (cdr a) b))))
 
(define (last-element s)
  (if (null? (cdr s))
      (car s)
      (last-element (cdr s))
      ))
 
(define (obl-element s)
  (if (null? (cddr s))
      (car s)
      (obl-element (cdr s))
      ))
 

Scheme Lecture 2

cond, lambda, let, let*, letrec, list

; solution with a too often call of minimum function (complexity O(n*n) where n is the length of s) 
(define (minimum s)
  (if (null? (cdr s))
      (car s)
      (if (< (car s) (minimum (cdr s)))
          (car s)
          (minimum (cdr s))))) 
 
; effective solution with support nested function minimum-e with acumulator variable m (complexity O(n)) 
(define (minimum0 s)
  (define (minimum-e m s)
    (if (null? s) m 
        (if (> m (car s))
            (minimum-e (car s) (cdr s))
            (minimum-e m (cdr s))
            )))
  (minimum-e (car s) s)
 )
 
; effective solution with lambda form (complexity O(n) where n is the length of s) 
(define (minimum1 s)
  (if (null? (cdr s))
      (car s)
      ((lambda (x y) (if (< x y)
           x
           y)) (car s) (minimum1 (cdr s))) 
))
 
; same effective solution with let form 
(define minimum2 
  (lambda (s)
  (if (null? (cdr s))
      (car s)
      (let ( (x (car s))
             (y (minimum2 (cdr s)))
           )
        (if (< x y)
            x
            y
       )     
      ))))
(define split (lambda (s)
                (cond
                  ((null? (cdr s)) (cons s '()))
                  ((null? (cddr s)) (cons (list (car s)) (cdr s)))
                  (else (let* (
                               (ab (split (cddr s)))
                               (a (car ab))
                               (b (cdr ab))
                              )
                          (cons (cons (car s) a) (cons (cadr s) b))
                          )))))
 
(define (merge a b comparator)
  (cond
    ((null? a) b)
    ((null? b) a)
    ((comparator (car a) (car b)) (cons (car a) (merge (cdr a) b comparator)))
    (else (merge b a comparator))))
 
(define (merge-sort s comparator)
  (cond
    ((null? s) s)
    ((null? (cdr s)) s)
    (else (let* (
                 (ab (split s))
                 (sa (merge-sort (car ab) comparator))
                 (sb (merge-sort (cdr ab) comparator))
                )
            (merge sa sb comparator)))))
 
; example of merge-sort call
> (merge-sort '(4 3 2 1 5) (lambda (x y) (<= x y)))
(1 2 3 4 5)
 

Scheme Lecture 3

lambda with multiple arguments, list, eval, (interaction-environment), (scheme-report-environment 5), (null-environment 5), apply, map, display, newline, tail recursion optimization, vector, list→vector, vector→list, make-vector, vector-ref

(define (listt s)
  (if (null? s) 
      s
      (cons (car s) (listt (cdr s)))))
 
;equivalent implementation of built-in list
(define list1 (lambda s
                (listt s)))
 
;yet another equivalent implementation of built-in list
(define list2 (lambda s s))
;simplified (it accepts only two arguments instead of multiple) implementation of built-in apply
(define (apply1 f  s)
  (eval (cons f s) (interaction-environment)))
 
;full implementation of built-in apply
(define (apply2 f . s)
  (define (collect s)
    (if (null? (cdr s)) (car s)
        (cons (car s) (collect (cdr s)))))
; (display s)
; (newline)
  (eval (cons f (collect s)) (interaction-environment)))
(define (take-first s)
  (if (null? s) '()
      (cons (caar s) (take-first (cdr s)))))
(define (take-rest s)
  (if (null? s) '()
      (cons (cdar s) (take-rest (cdr s)))))
 
;full implementation of built-in map
(define (map1 f . s)
  (if (null? (car s)) '()
      (cons (apply f (take-first s)) (apply map1 f (take-rest s)))))
 
; example:
> (map - '(1 2 3 4))
(-1 -2 -3 -4)
; zip function with multiple arguments 
(define zip (lambda ss
              (apply map list ss)))
 
; example:              
> (zip '(1 2 3 4) '(a b c d) '(v x y z))
((1 a v) (2 b x) (3 c y) (4 d z))
; reverse function with tail recursive call
(define (reverse1 s)
  (define (reverse-acc acc s)
    (if (null? s) acc
        (reverse-acc (cons (car s) acc) (cdr s)))) ; tail recursion optimization
  (reverse-acc '() s))
(define (list-ref-update s r u)
  (if (= r 0) (cons u (cdr s))
      (cons (car s) (list-ref-update (cdr s) (- r 1) u))))
 
; example:
> (list-ref-update '(1 2 3 4) 2 'u)
(1 2 u 4)

Scheme Lecture 4

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

(define stack '())
 
(define (top) 
  (car stack))
 
(define (push o) 
  (set! stack (cons o stack)))
 
(define (pop)
  (if (null? stack)
      #f
      (let ((r (top)))
        (set! stack (cdr stack))
        r)))
 
; example: 
> stack
()
> (push 1)
> (push '(2 1))
> (push 'a)
> (top)
a
> (pop)
a
> stack
((2 1) 1)
> (pop)
(2 1)
> (pop)
1
> (pop)
#f
>
(define (make-cyclic-list! s)
  (define (mcl! x)
    (if (null? (cdr x)) (set-cdr! x s)
        (mcl! (cdr x))))
  (mcl! s))
 
; example:
> (let ((s '(1 2 3)))
    (make-cyclic-list! s) 
    s)
#0=(1 2 3 . #0#) 
(define (next-day d)
  (letrec (
           (week (list 'mon 'tue 'wed 'thu 'fri 'sat 'sun)) 
           (find (lambda (w) (if (equal? d (car w)) 
                                 w
                                 (find (cdr w))
                                 )))
           )
    (make-cyclic! week)
    (cadr (find week))
    ))
 
; It is very important to create the names of the days of the week list
; by 'list' or 'cons' function. Otherwise make-cyclic! changes the strucure 
; of the code and the second call of 'next-day' function will 
; freeze in a neverendless loop because make-cyclic never finds
; the end of 'week' list!     
 
; example
> (next-day 'sun)
mon
(define (multiply s)  
  (call-with-current-continuation 
   (lambda (exit) 
     (letrec (
              (mul (lambda (s)
                     (if (= 0 (car s))
                         (exit 0)
                         (if (null? (cdr s)) (car s)
                             (* (car s) (multiply (cdr s)))
                             ))))
              )
       (mul s))))
  )
 
; 'multiply' function returns 0 by 'exit 0' immediatelly (it jumps throw all recursive calls)
; when zero element occurrs in the input list s. 

Scheme Lecture 5

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

(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 1 (lcons 2 (lcons 3 '()))))))
3
> (lcar (lcdr (lcons 1 (lcons 2 (lcons 3 '())))))
2
 
misc/projects/oppa_oi_english/courses/ae4b33flp/scheme.txt · Last modified: 2013/10/04 13:02 (external edit)