Late nights stuck at work on the weekends.

Fold gives me a hard on now. I’ll have to play with it more after some coffee. Think I’ll check out the reference implementation for SRFI 1, it looks like some sexy shit.


;;; Following along with:
; A tutorial on the universality and
; expressiveness of fold
; GRAHAM HUTTON
; University of Nottingham, Nottingham, UK
; http://www.cs.nott.ac.uk/-gmh
; J. Functional Programming 9 (4): 355–372, July 1999.
; Retreived from http://www.cs.nott.ac.uk/~gmh/fold.pdf

;; I use these at random.
(define first car)
(define second cadr)
(define head car)
(define tail cdr)
(define rest cdr)

;; fold, sum, product
;; Pg. 356(Journal)/2(PDF)
;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (fold func base lst)
; (if (null? lst)
; base
; (func (first lst) (fold func base (rest lst)))))
(let loop ((lst lst))
(if (null? lst)
base
(func (first lst) (loop (rest lst))))))

(define (sum lst)
;; Pg 13 recommends foldl, iterative.
(fold + 0 lst))

(define (product lst)
(fold * 1 lst))

;; Pg. 3
;; length, append, reverse, map, filter
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; fold (:) ys
(define (append hd tl)
;; This will share the tail.
;; (fold cons (fold cons tl '()) hd)) wouldn't,
;; but would still share (any (nested) lists).
(fold cons tl hd))

;; fold (λx n → 1 + n) 0
(define (length lst)
;; Remember that conceptually, fold is
;; (f (first lst) (fold f v (rest lst)))
;; so (length '(a b c)) basically becomes
;; (+ 1 (+ 1 (+ 1 0)))
(fold (lambda (hd tl) (+ 1 tl)) 0 lst))

;; fold (λx xs → xs + [x]) []
(define (reverse lst)
;; XXX This is shit.
; (fold (lambda (hd tl) (append tl (list hd))) (list) lst))
;; Improved, pg. 13.
;; foldl (λxs x → x : xs) []
(foldl (lambda (hd tl) (cons tl hd)) (list) lst))

;; fold (λx xs → f x : xs) []
(define (map func lst)
;; (map +1 '(1 2))
;; (cons (+1 1) (cons (+1 2) '()))
(fold (lambda (hd tl) (cons (func hd) tl)) (list) lst))

;; fold (λx xs → if p x then x : xs else xs) []
(define (filter pred? lst)
;; Haskell's syntax becomes appealing.
(fold (lambda (hd tl)
(if (pred? hd)
(cons hd tl)
tl))
(list)
lst))

;; Pg. 8
;; Sumlength
;;;;;;;;;;;;

;; fold (λn (x, y) → (n + x, 1 + y)) (0, 0)
(define (sumlength lst-of-nums)
; (fold (lambda (hd pair)
; (cons (+ hd (first pair))
; (+ 1 (second pair))))
; (cons 0 0)
; lst-of-nums))
;; Spew less interim garbage.
(fold (lambda (hd pair)
(set-car! pair (+ hd (first pair)))
(set-cdr! pair (+ 1 (rest pair)))
pair)
(cons 0 0)
lst-of-nums))

;; Pg 11.
;; compose
;;;;;;;;;;;;;;

;; fold (·) id
(define (compose lst)
(fold (lambda (fun1 fun2) ; dot
(lambda (x)
(fun1 (fun2 x))))
(lambda (x) x) ; id
lst))

;; Pg. 13
;; foldl
;;;;;;;;;

;; foldl f (f v x) xs
(define (foldl fun start lst)
; (if (null? lst)
; start
; (foldl fun
; (fun start (first lst))
; (rest lst))))
;; Don't keep passing fun around.
(let loop ((result start) (lst lst))
(if (null? lst)
result
(loop (fun result (first lst))
(rest lst)))))

(define (tst name result)
(if (not result)
(begin (display name)
(newline))))

(tst 'sum (= 15 (sum '(1 2 3 4 0 5))))
(tst 'rev (equal? '(baz (bar) foo)
(reverse '(foo (bar) baz))))
(tst 'app (equal? '(foo bar baz)
(append '(foo bar) '(baz))))
(tst 'len (= 3 (length '(a b c))))
(tst 'len (= 2 (length '(a '(b c)))))
(tst 'map (equal? '(1 2 3 4 5)
(map (lambda (x) (+ 1 x))
'(0 1 2 3 4))))
(tst 'filt (equal? '(2 4 6)
(filter even? '(1 2 3 3 5 7 4 599 99 6))))
(tst 'sumlen (equal? (cons 20 4) (sumlength '(2 4 6 8))))