541 CS Lecture -*- Outline -*-
* FP systems (may omit)
John Backus's langauge, from his turing award lecture
in contrast to systems based on lambda calculus,
no way to make new combining forms
(i.e. can only name compositions of built-in things)
** FP primitives
***all functions are unary
if need more than one argument, take list of args
-------
(define (apply2 f p)
(cond ((equal? (length p) 2) (f (car p) (cadr p)))
(else (error "wrong number of arguments to" f))))
(define (fp-ize f)
(lambda (p) (apply2 f p)))
(define fp-plus (fp-ize +))
(define fp-times (fp-ize *))
; etc.
------
***reduction functional, red
---------
(define (red f)
(define (fp-reduce f lst)
; requires: lst is non-empty
(cond ((null? (cdr lst)) (car lst))
(else (f (list (car lst) (fp-reduce f (cdr lst)))))))
(lambda (lst)
(fp-reduce f lst)))
---------
((red fp-plus) '(1 2 3 4))
; Value: 10
***mapping functional
-------
(define (fp-map f)
(lambda (l) (map f l)))
-------
((fp-map fp-plus) '((5 6) (7 8)))
; Value: (11 15)
***composition functional
--------
(define compose (fp-ize (lambda (f g) (lambda (x) (f (g x))))))
--------
((compose (list fp-times fp-map fp-plus)) '((5 6) (7 8)))
;Value: 165
((compose `(,fp-times ,fp-map ,fp-plus)) '((5 6) (7 8)))
;Value: 165
***constant functional
---------
(define (const k)
(lambda (x) k))
---------
((const 3) 4)
;Value: 3
***transposition
---------
(define (transpose ll)
(define (map2 f l1 l2)
(cond ((or (null? l1) (null? l2)) '())
(else (cons (f (car l1) (car l2))
(map2 f (cdr l1) (cdr l2))))))
(map2 list (car ll) (cadr ll)))
---------
(transpose '((1 2 3) (4 5 6)))
;Value: ((1 4) (2 5) (3 6))
***distribute left and right
---------
(define (distl xl)
(let ((x (car xl))
(l (cadr xl)))
(map (lambda (y) (list x y)) l)))
(define (distr lx)
(let ((x (cadr lx))
(l (car lx)))
(map (lambda (y) (list y x)) l)))
---------
(distl '(5 (1 2 3)))
; Value: 1) ((5 (5 2) (5 3))
(distr '((1 2 3) 5))
; Value: ((1 5) (2 5) (3 5))
*** constructor functional
--------
; turns list of functions into a function
(define (constr lf)
(define (fun-list-apply lf x)
(cond ((null? lf) '())
(else (cons ((car lf) x)
(fun-list-apply (cdr lf) x)))))
(lambda (x) (fun-list-apply lf x)))
--------
((constr `(,fp-plus ,fp-times ,fp-plus)) '(3 4))
; Value: (7 12 7)
** Example: vector product
----------
(define fp-vec-prod (compose `(,(fp-map fp-times) ,transpose)))
----------
(fp-vec-sum '((1 2 3) (4 5 6)))
; Value: (4 10 18)
** Example: inner product (ip U V) = sum of U[i]*V[i]
----------
(define ip (compose (list (red fp-plus) fp-vec-prod)))
----------
(ip '((1 2 3) (4 5 6)))
; Value: 32
** Example: matrix multiplication
----------
(define prod-row (compose `(,(fp-map ip) ,distl)))
(define mat-prod
(compose (list
(compose (list (fp-map prod-row) distr))
(constr (list car (compose (list transpose cadr)))))))
; (mat-prod '(((1 2 3) (4 5 6))
; ((7 8) (9 10) (11 12) (13 14))))
;Value: ((25 28) (73 82))
----------
derivation of matrix multiplication
point: simple, but unfamiliar, equational reasoning
let A be l*m, B be m*n matricies
want: (mat-prod A B) = (P[i,k])
where P[i,k] = sum from j=1 to m of A[i,j]*B[j,k].
so P[i,k] = (ip (list A[i,*] B[*,k]))
notation: P[i,*] = (list P[i,1] ... P[i,n])
so P[i,*] = ((fp-map ip) (list (list A[i,*] B[*,1]) ...
(list A[i,*] B[*,n])))
factor out the constant argument with distl
so P[i,*]= ((compose (list (fp-map ip) distl))
(list A[i,*] (transpose B)))
(define prod-row (compose (list (fp-map ip) distl)))
do this for each row of A
so P = ((fp-map prod-row) (list (list A[1,*] (transpose B))...
(list A[l,*] (transpose B))))
factor out the (transpose B) using distr
P = ((compose (list (fp-map prod-row) distr))
(list A (transpose B)))
given (list A B) get back (list A (transpose B)) using
(constr (list car (compose (list transpose cadr))))