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 lstofnums)
; (fold (lambda (hd pair)
; (cons (+ hd (first pair))
; (+ 1 (second pair))))
; (cons 0 0)
; lstofnums))
;; Spew less interim garbage.
(fold (lambda (hd pair)
(setcar! pair (+ hd (first pair)))
(setcdr! pair (+ 1 (rest pair)))
pair)
(cons 0 0)
lstofnums))
;; 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))))
No comments yet.

Recent

Links

Archives
 October 2011 (1)
 January 2011 (2)
 August 2010 (5)
 July 2010 (5)
 May 2010 (3)
 March 2010 (10)
 February 2010 (7)
 November 2009 (1)
 October 2009 (1)
 August 2009 (1)
 July 2009 (3)
 April 2009 (2)

Categories

RSS
Entries RSS
Comments RSS
Leave a Reply