Tutorial 1 (14.2.2013)

  • Introduction to IDE PLT DrRacket
  • Basic syntax, functions, atoms, lists, quote
(define (diskr a b c)
  (- (* b b) (* 4 a c))
)
 
(define (roots a b c)
  (list
    (/ (+ (- b) (sqrt (diskr a b c))) (* 2 a))
    (/ (- (- b) (sqrt (diskr a b c))) (* 2 a))
  )
)
 
(define (fib n)
  (cond ((= n 0) 0)
        ((= n 1) 1)
        (else (+ (fib (- n 1)) (fib (- n 2))))
   )
)
 
(define (sude? n)
  (cond ((= n 0) #t)
        ((= n 1) #f)
        ((> n 0) (sude? (- n 2))
        (else (sude? (+ n 2))
   )
)
 
(define (vypis-sude l)
  (cond ((null? l) l)
        ((sude? (car l)) (cons (car l) (vypis-sude (cdr l))))
        (else (vypis-sude (cdr l)))
   )
)

S použitím append z prednášky:

(define (reverse l)
  (cond ((null? l) l)
        (else (append (reverse (cdr l)) (list (car l))))
   )
)

Tutorial 2 (21.2.2013)

(define (reverse l)
  (rev-acc l '())
)
 
(define (rev-acc l acc)
  (cond ((null? l) acc)
        (else (rev-acc (cdr l) (cons (car l) acc)))
   )
)
(define (flat l)
  (cond ((null? l) l)
        ((list? (car l)) (append (flat (car l)) (flat (cdr l))))
        (else (cons (car l) (flat (cdr l))))
  )
)

Moore efficient version with accumulator:

(define (flat l)
  (flat-acc l '())
)
 
(define (flat-acc l acc)
    (cond ((null? l) acc)
          ((list? (car l)) (flat-acc (car l) (flat-acc (cdr l) acc)))
          (else (cons (car l) (flat-acc (cdr l) acc)))
    )
)
(define (filter pred list)
  (cond ((null? list) list)
        ((pred (car list)) (cons (car list) (filter pred (cdr list))))
        (else (filter pred (cdr list)))
   )
)
 
> (filter (lambda (x) (> x 5)) '(1 2 5 7 8 8 3 4 6))
(define (apply-at fn list pos)
  (cond ((= pos 0) (cons (fn (car list)) (cdr list)))
        (else (cons (car list) (apply-at fn (cdr list) (- pos 1))
   )
)
 
> (apply-at (lambda (x) (+ x 1)) '(1 2 3 4) 2)
 
(define (subst new list pos)
  (apply-at (lambda (x) new) list pos)
)
 
> (subst 'a '(1 2 3 4 5) 2)
 
(define (apply-xy fn x y list-of-lists)
  (apply-at (lambda (line)
              (apply-at fn line x)
             ) list-of-lists y)
)
 
> (apply-xy (lambda (x) (+ x 1)) 1 2 
     '((0 0 0 0)
       (0 0 0 0) 
       (0 0 0 0)
       (0 0 0 0)))

Tutorial 3 (28.2.2013)

(define (dist p1 p2)
  (let ((dx (- (car p1) (car p2)))
        (dy (- (cadr p1) (cadr p2)))
        )
    (sqrt (+ (* dx dx) (* dy dy)))
   )
)
(map sqrt '(1 4 9 16 25))
(map car '((A B) (C) (D E)))
(map max '(3 9 17) '(2 4 11) '(7 3 2))
 
(define (pascal n)
  (cond ((= n 1) '(1))
        (else (let ((prev (pascal (- n 1))))
                (map + (cons 0 prev) (append prev '(0)))
              )
        )
  )
)
 
(define (fold fn a list)
  (cond ((null? list) a)
        (else (fn (car list) (fold fn a (cdr list))))
  )
)
 
(define (sum list)
  (fold + 0 list)
)
 
(define (min list)
  (fold (lambda (x y) (if (< x y) x y)) (car list) (cdr list))
)
 
 
(define (sum-leafs tree)
  (fold
    (lambda (x sum) (+ sum (if (list? x) (sum-leaves x) x)))
    0 tree
  )
)
 
(define (dot-product v w)
  (fold + 0 (map * v w)))
 
(define (mxv m v)
  (map (lambda (row) (dot-product row v)) m))

Tutorial 4 (7.3.2013)

(define (transpose mat)
   (apply map (cons list mat)))
 
(define (mxm m n)
  (let ((cols (transpose n)))
    (map (lambda (row) (mxv cols row))
         m)))
(define (power-set s)
  (if (null? s) '(())
      (let ((rest-ps (power-set (cdr s))))
          (append rest-ps (map (lambda (x) (cons (car s) x)) rest-ps))
)))
 
(define (perm-set l)
  (if (null? l) '(())
  (apply append (map (lambda (x)
                  (map (lambda (y) (cons x y)) (perm-set (remove x l)))
                ) l))
))

Tutorial 5 (14.3.2013)

(define (fold fn a li)
    (if (null? li) a
        (fn (car li) (fold fn a (cdr li)))))
 
(define (mymap f l)
  (fold (lambda (x y)
          (cons (f x) y)) '() l)
)
((lambda (rec-fun par1) (rec-fun rec-fun par1))
   (lambda (len l)
     (if (null? l) 0
         (+ 1 (len len (cdr l))))
   ) '(a b c d e))
(define (ints-from n)
 (cons n (delay (ints-from (+ n 1)))))
 
(define nat-nums (ints-from 1))
 
(define (rest stream)
  (if (list? (cdr stream)) (cdr stream)
      (force (cdr stream))))
(define first car)
 
(define (first-n n stream)
  (if (or (= n 0) (null? stream)) '()
      (cons (first stream) (first-n (- n 1) (rest stream)))))
 
 
(define (lazy_map f stream)
  (if (null? stream) stream
      (cons (f (first stream))
            (delay (lazy_map f (rest stream))))))
 
(define (lazy_append a b)
  (if (null? a) b
      (cons (first a) (delay (lazy_append (rest a) b)))))
 
(define (lazy_power-set s)
  (if (null? s) '(())
      (let ((rest-ps (lazy_power-set (cdr s))))
          (lazy_append rest-ps (lazy_map (lambda (x) (cons (car s) x)) rest-ps)))))
 
misc/projects/oppa_oi_english/courses/ae4b33flp/scheme_tutorials.txt · Last modified: 2013/10/04 13:02 (external edit)