# Scheme

Esoteric expressions

((lambda x x) (lambda x x))

(define id ((lambda (x) x) (lambda (x) x)))

((lambda xs xs))

(define list (lambda xs xs))

(define (atom? x) (not (pair? x)))

`'()`

is a `List`

but not a `Pair`

## Lists

(define (list? xs) (cond ((null? xs) #t) ((and (pair? xs) (null? (cdr xs))) #t) (else #f)))

(define (list? xs) (or (null? xs) (and (pair? xs) (null? (cdr xs)))))

(define (last? xs) (and (not (null? xs)) (null? (cdr xs))))

## map

(define (map f xs) (if (null? xs) '() (cons (f (car xs)) (map f (cdr xs)))))

(define (map f xs) (define (recur xs) (if (null? xs) '() (cons (f (car xs)) (recur (cdr xs))))) (recur xs))

(define (map f xs) (letrec ((recur (lambda (xs) (if (null? xs) '() (cons (f (car xs)) (recur (cdr xs))))))) (recur xs)))

(define (map f xs) (let recur ((ys xs)) (if (null? ys) '() (cons (f (car ys)) (recur (cdr ys))))))

foldl pattern, tail-recursive, O(2n)

(define (map f xs) (define (iter acc xs) (cond ((null? xs) (reverse acc)) (else (iter (cons (f (car xs)) acc) (cdr xs))))) (iter '() xs))

## folds

(define (foldr f z xs) (if (null? xs) z (f (car xs) (foldr f z (cdr xs)))))

(define (map f xs) (foldr (lambda (x xs) (cons (f x) xs)) '() xs))

map f = foldr ((:) . f) []

(define (foldl f acc xs) (if (null? xs) acc (foldl f (f acc (car xs)) (cdr xs))))

(define (reverse xs) (foldl (flip cons) '() xs))

constant-space, tail-recursive O(2n) - the cost of extra reverse

(define (foldr f z xs) (foldl (flip f) z (reverse xs)))

(define map (lambda (f xs) (reverse (foldl (lambda (xs x) (cons (f x) xs)) '() xs))))

map f = reverse . foldl (flip ((:) . f)) []

(define (foldr1 f xs) (cond ((null? xs) (error "foldr1 on '()")) ((last? xs) (car xs)) (else (f (car xs) (foldr1 f (cdr xs))))))

(define (foldl1 f xs) (if (null? xs) (error "foldl1 on '()") (foldl f (car xs) (cdr xs))))

## partially

(define partially (lambda (f . as) (lambda xs (apply f (append as xs)))))

(define copy (partially foldr cons '()))

(define reverse (partially foldl (flip cons) '()))

(define length (partially foldl (lambda (acc x) (+ 1 acc)) 0))

(define sum (partially foldl + 0))

## macros

(define-syntax when (syntax-rules () ((when condition form ...) (if condition (begin form ...)))))

(define-syntax unless (syntax-rules () ((unless condition form ...) (if (not condition) (begin form ...)))))

(define-syntax assert (syntax-rules () ((assert condition . extra) (unless condition (error "Assertion failed:" 'condition . extra)))))

## check-expect

(define-syntax check-expect (syntax-rules () ((_ check expect) (let ((checked check) (expected expect)) (if (not (equal? checked expect)) (begin (display "expression: ") (write (quote check)) (newline) (display "received: ") (write checked) (newline) (display "expected: ") (write expected) (newline)) (if #f #t))))))

## Streams

(define-syntax stream-cons (syntax-rules () ((_ x xs) (cons x (delay xs)))))

(define (stream-cdr xs) (force (cdr xs)))

(define (stream-map f xs) (stream-cons (f (car xs)) (stream-map f (stream-cdr xs))))

(define (stream-filter f xs) (if (f (car xs)) (stream-cons (car xs) (stream-filter f (stream-cdr xs))) (stream-filter f (stream-cdr xs))))

(define (stream-take n xs) (if (<= n 0) '() (cons (car xs) (stream-take (- n 1) (stream-cdr xs)))))

(define (repeat x) (stream-cons x (repeat x)))

(define (iterate f x) (stream-cons x (iterate f (f x))))

(define (replicate n x) (stream-take n (repeat x)))

## Newton's method

see also Standard ML

Last modified 14 months ago
Last modified on May 19, 2018, 11:03:20 AM