Warning
This page is located in archive.

Scheme přednáška 1

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

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

(define (posledni s)
  (if (null? (cdr s)) (car s)
      (posledni (cdr s))
      )
  )

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

Scheme přednáška 2

append, cond, lambda, let, let*, letrec

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

(define (minimum1 s)
  (if (null? (cdr s))
      (car s)
      (if (> (car s) (cadr s))
          (minimum1 (cdr s))
          (minimum1 (cons (car s) (cddr s)))
          )))
 
(define (minimum2 s)
  (if (null? (cdr s))
      (car s)
      (if (< (car s) (minimum2 (cdr s)))
          (car s)
          (minimum2 (cdr s))
          )))
 
(define (minimum3 s)
  (if (null? (cdr s))
      (car s)
      ((lambda (m)
         (if (< (car s) m)
             (car s)
             m
             )
         )
       (minimum3 (cdr s))
       )    
      ))
 
(define (minimum4 s)
  (if (null? (cdr s))
      (car s)
      (let (
            (m (minimum4 (cdr s)))
            )
        (if (< (car s) m)
            (car s)
            m
            ))))

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

> (qsort >= '(7 6 4 3 5 2 1))
(7 6 5 4 3 2 1)

Scheme přednáška 3

lambda s proměnlivým počtem argumentů, list, eval, (interaction-environment), (scheme-report-environment 5), (null-environment 5), apply, display, newline, begin

(define (my-list2 z)
  (if (null? z) '()
      (cons (car z) (my-list2 (cdr z)))
      ))
 
(define (my-list . z) ; alternativní definice vestavěné funkce list
  (my-list2 z)
  )

(define my-list3 (lambda z z) ; další alternativní definice funkce list
  )

(define (plus . z) ; alternativní definice funkce '+' s využitím funkce eval
  (if (null? z) 0
      (+ (car z) (eval (cons plus (cdr z))
                       (interaction-environment))
         )))

(define (plus2 . z) ; další alternativní definice funkce '+' s využitím funkce apply
  (if (null? z) 0
      (+ (car z) (apply plus2 (cdr z)))
      ))

(define (my-apply f a) ; alternativní definice zjednodušené (akceptuje pouze 2 argumenty namísto více) funkce apply
  (eval (cons f a) (interaction-environment)))

Scheme přednáška 4

map, call-with-current-continuation, vector, vector?, list?, list→vector, vector→list, make-vector, vector-ref, set-vector!, set!, set-car!, set-cdr!, cyklické datové struktury, jazykem scheme garantovaná optimalizace koncového volání (tail call optimization)

(define (take-first ls)
  (if (null? ls) '()
      (cons (caar ls) (take-first (cdr ls)))
      ))
 
(define (take-rest ls)
  (if (null? ls) '()
      (cons (cdar ls) (take-rest (cdr ls)))
      ))
 
(define (my-map f . ls) ; alternativní implementace vestavěné funkce map
  (if (null? (car ls)) '()
      (cons (apply f (take-first ls))
            (apply my-map f (take-rest ls)))))
(define (sm s exit) ; vynásobí prvky v seznamu a pokud najde 0 rychle ukončí výpočet funkcí exit 
  (if (null? (cdr s)) (car s)
      (if (= (car s) 0) (exit 0)
          (sm (cons (* (car s) (cadr s)) (cddr s)) exit))
          ))
 
(define (smart-multiplication ls) ; vynásobí všechny prvky ve vstupním seznamu
  (call-with-current-continuation
   (lambda (exit)
     (sm ls exit)
     )))
(define (make-cyclic-list! s)
  (define (mcl! x)
    (if (null? (cdr x)) 
        (set-cdr! x s)
        (mcl! (cdr x))))
  (mcl! s))
 
>(define tyden '(pondeli utery streda ctvrtek patek sobota nedele))
 
>(make-cyclic-list! tyden)
 
> tyden
#0=(pondeli utery streda ctvrtek patek sobota nedele . #0#)

 
(define stack '())
(define (top) (car stack))
(define (push o) (set! stack (cons o stack)))
(define (pop) 
  (let (
        (a (top))
        )
    (set! stack (cdr stack))
    a
    ))

Scheme přednáška 5

quasiquote (`), unquote (,), unquote-splicing(,@), delay, force, reprezentace seznamů jako stream, implementace ekvivalentů k funkcím: cons, car a cdr pouze s lambda

; funkce der vypočítá 1. derivaci výrazu <expr> podle proměnné <x>
; výraz <expr> může obsahovat +, -, *, / (pouze binarni pripad), sin, proměnnou <x> a čísla.
(define (der e x)
  (define (d expr)
    (der expr 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) '*)
     (if (null? (cddr e))
         (d (cadr e))
         (let* ( (f (cadr e))
                 (h `(* ,@(cddr e)))
                 (fp (d f))
                 (hp (d h))
                 )
           `(+ (* ,fp ,h) (* ,f ,hp))
           )))
    ((equal? (car e) '/)
     (let* ( (f (cadr e))
             (h (caddr e))
             (fp (d f))
             (hp (d h))
             )
       `(/ (- (* ,fp ,h) (* ,f ,hp)) (* ,h ,h))
       ))
    ((equal? (car e) 'sin)
     `(* (cos ,(cadr e)) ,(d (cadr e)))) 
    ))
 
; příklad:
> (der 1 'x)
0
> (der 'x 'x)
1
> (der '(+ 2 x 4) 'x)
(+ 0 1 0)
> (der '(- x x (+ x 1)) 'x)
(- 1 1 (+ 1 0))
> (der '(sin (sin (+ x y))) 'y)
(* (cos (sin (+ x y))) (* (cos (+ x y)) (+ 0 1)))

(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

courses/a4b33flp/2014/scheme.txt · Last modified: 2015/02/16 12:01 by vyskoji1