;; често използвани функции (define (id x) x) (define (1+ x) (+ x 1)) (define (compose f g) (lambda (x) (f (g x)))) ;; натрупване от по-висок ред (define (accumulate op nv a b term next) (if (> a b) nv (op (term a) (accumulate op nv (next a) b term next)))) (define (accumulate-i op nv a b term next) (if (> a b) nv (accumulate-i op (op nv (term a)) (next a) b term next))) ;; стандартни генератори на списъци (define (collect a b next) (if (> a b) '() (cons a (collect (next a) b next)))) (define (from-to a b) (collect a b 1+)) ;; фунции от по-висок ред за списъци (define (filter p? l) (cond ((null? l) l) ((p? (car l)) (cons (car l) (filter p? (cdr l)))) (else (filter p? (cdr l))))) (define (foldr op nv l) (if (null? l) nv (op (car l) (foldr op nv (cdr l))))) (define (foldl op nv l) (if (null? l) nv (foldl op (op nv (car l)) (cdr l)))) (define (foldr1 op l) (if (null? (cdr l)) (car l) (op (car l) (foldr1 op (cdr l))))) (define (foldl1 op l) (foldl op (car l) (cdr l))) (define (search p l) (and (not (null? l)) (or (p (car l)) (search p (cdr l))))) (define (all? p? l) (not (search (lambda (x) (not (p? x))) l))) ;; функции за графи (define (vertices g) (map car g)) (define (children u g) (cdr (assq u g))) (define (edge? u v g) (memv v (children u g))) (define (map-children v f g) (map f (children v g))) (define (search-child v f g) (search f (children v g))) ;; функции за потоци (define the-empty-stream '()) (define-syntax cons-stream (syntax-rules () ((cons-stream h t) (cons h (delay t))))) (define head car) (define (tail s) (force (cdr s))) (define empty-stream? null?) (define (map-stream f s) (cons-stream (f (head s)) (map-stream f (tail s)))) (define (filter-stream p? s) (if (p? (head s)) (cons-stream (head s) (filter-stream p? (tail s))) (filter-stream p? (tail s)))) (define (zip-streams op s1 s2) (cons-stream (op (head s1) (head s2)) (zip-streams op (tail s1) (tail s2))))