(load "~kurt/cs61a/lib/obj.scm")
(define pi 3.14)
;; Today:
;; o Inheritance
;;
;;
;; Wednesday and Thursday:
;; OOP below-the-line
;;
;;
;; Ramifications of OOP
;;
;; o Consider our beloved geometry package:
(define-class (circle radius)
(instance-vars (num-accesses 0)) ;; 1 for each instance
(class-vars (num-circles 0)) ;; shared with every instance
(initialize (set! num-circles (+ num-circles 1)))
(method (access) (set! num-accesses (+ num-accesses 1)))
(method (area)
(ask self 'access)
(* pi radius radius))
(method (perimeter)
(ask self 'access)
(* 2 pi radius)))
(define c1 (instantiate circle 3))
(ask c1 'radius)
(ask c1 'area)
(define-class (square side)
(instance-vars (num-accesses 0)) ;; 1 for each instance
(class-vars (num-squares 0)) ;; shared with every instance
(initialize (set! num-squares (+ num-squares 1)))
(method (access) (set! num-accesses (+ num-accesses 1)))
(method (area)
(ask self 'access)
(* side side))
(method (perimeter)
(ask self 'access)
(* 4 side)))
;;
;; o Easy to add a new shape (new class)
;;
;; o Hard to add new operator
;;
;; o Also, lots of shared code
;;
;; Big Idea: Inheritance
;;
;; Objects that have functionality in common can be
;; re-conceptualized as specializations of a shared
;; generalization.
;;
;;
;; o Specifically:
;; o A 'child' class can have a 'parent' class.
;; o A subclass can use all the methods/state
;; of the parent.
;; o Inheritence is recursive
;;
;; o For the geometry system:
;; o A parent class contains methods/variables
;; common to all shapes:
(define-class (shape)
(instance-vars (num-accesses 0)) ;; 1 for each instance
(class-vars (num-shapes 0)) ;; shared with every instance
(initialize (set! num-shapes (+ num-shapes 1)))
(method (access) (set! num-accesses (+ num-accesses 1)))
(method (area) 'Unknown!)
(method (perimeter) 'Unknown!))
;; o Specific shapes, like circle, then inherit the
;; properties of the parent while adding their
;; own specialization:
(define-class (circle radius)
(parent (shape))
(class-vars (num-circles 0)) ;; shared with every instance
(initialize (set! num-circles (+ num-circles 1)))
(method (area)
(ask self 'access) ;; even though no 'access' method
(* pi radius radius))
(method (perimeter)
(ask self 'access)
(* 2 pi radius)))
(define-class (square side)
(parent (shape))
(class-vars (num-squares 0)) ;; shared with every instance
(initialize (set! num-squares (+ num-squares 1)))
(method (area)
(ask self 'access) ;; even though no 'access' method
(* side side))
(method (perimeter)
(ask self 'access)
(* 4 side)))
(define s1 (instantiate shape)) ;; can instant parents
(define c1 (instantiate circle 3))
(ask c1 'radius) ;; native to circles
(ask c1 'area) ;; overwritten by circle area proc
(ask c1 'num-accesses) ;; from parent
(ask c1 'num-circles)
(ask c1 'num-shapes) ;; from parent
(define c2 (instantiate circle 4))
(ask c1 'num-circles)
(ask c1 'num-shapes) ;; parent class var allows
;; communication 'across' types
;;
;; o Benefits to inheritance:
;;
;; 1. Modify behavior w/o rewriting entire object.
;; 2. Centralizes methods
;; 3. Specify general behavior, let subclass implement
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Usual:
;;
;; o Subclasses can 'overide' parent methods
;; o What if we want original behavior?
;; o Form: (usual )
;;
(define-class (shape)
(instance-vars (num-accesses 0)) ;; 1 for each instance
(class-vars (num-shapes 0)) ;; shared with every instance
(initialize (set! num-shapes (+ num-shapes 1)))
(method (access) (set! num-accesses (+ num-accesses 1)))
(method (area) '(Unknown area!))
(method (perimeter) '(Unknown perimeter!)))
(define-class (circle radius)
(parent (shape))
(class-vars (num-circles 0)) ;; shared with every instance
(initialize (set! num-circles (+ num-circles 1)))
(method (area)
(ask self 'access) ;; even though no 'access' method
(if (<= 0 radius)
(* pi radius radius)
(usual 'area))) ;; ask for parent's area
(method (perimeter)
(ask self 'access)
(* 2 pi radius)))
(define c1 (instantiate circle 3))
(define c2 (instantiate circle -1))
(ask c1 'area) ;; overwritten by circle area proc
(ask c2 'area)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Peer Instruction:
;;
;;
;; OOP Trees:
;;
;; Part I: define a basic tree class that has
;; properties similar to our regular tree ADT
;;
;; Part II: define a method tree-map.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-class (node datum children)
;; printing procs I wrote
(method (print)
(newline)
(ask self 'print-h 0 0)
'okay)
(method (print-h depth cur)
(if (< cur depth)
(begin (display " ")
(ask self 'print-h depth (+ cur 1)))
(begin (display "o ")
(display datum)
(newline)
(map (lambda (x) (ask x 'print-h (+ depth 1) 0))
children)))))
(define n0 (instantiate
node
1
(list (instantiate node 2 '())
(instantiate node 3 (list (instantiate node 4 '())
(instantiate node 5 '())))
(instantiate node 6 '()))))
(ask n0 'print)
;;
;; Ok, can we get trees to map?
;;
(define-class (node datum children)
(method (map fn)
(set! datum (fn datum))
(map (lambda (x) (ask x 'map fn))
children))
(method (print)
(newline)
(ask self 'print-h 0 0)
'okay)
(method (print-h depth cur)
(if (< cur depth)
(begin (display " ")
(ask self 'print-h depth (+ cur 1)))
(begin (display "o ")
(display datum)
(newline)
(map (lambda (x) (ask x 'print-h (+ depth 1) 0))
children)))))
(define n0 (instantiate
node
1
(list (instantiate node 2 '())
(instantiate node 3 (list (instantiate node 4 '())
(instantiate node 5 '())))
(instantiate node 6 '()))))
(ask n0 'print)
(ask no 'map (lambda (x) (wd x x x)))
(ask no 'print)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Multiple Inheritance
;;
;; o You can think of inheritance as a tree of classes:
;;
(define-class (shape))
(define-class (circle)
(parent (shape)))
(define-class (pgram)
(parent (shape)))
(define-class (rectangle)
(parent (shape))
(method (talk) '(hello I am a rectangle)))
(define-class (rhombus)
(parent (shape))
(method (talk) '(hello I am a rhombus)))
(define rect1 (instantiate rectangle))
(define rhomb1 (instantiate rhombus))
;;
;; o But objects can have multiple parents
;;
(define-class (square)
(parent (rectangle) (rhombus)))
(define square1 (instantiate square))
(ask square1 'talk)
;;
;; o When searching for a method, will check
;; first parent first.
;;
(define-class (square)
(parent (rhombus) (rectangle)))
(define square1 (instantiate square))
(ask square1 'talk)
;;
;; o The search is done 'depth first':
;;
(define-class (a)
(method (talk) '(I'm an A)))
(define-class (b)
(parent a)) ;; no talk
(define-class (c)
(parent a)
(method (talk) '(I'm a C)))
(define-class (z)
(parent b c))
(define foo (instantiate z))
(ask foo 'talk)
;;
;; o Question: Consider these:
;;
(define-class (p)
(initialize (display " ** I am p! ** ")))
(define-class (q)
(parent (p))
(initialize (display " ** I am q! ** ")))
;; o What is the result of:
(instantiate q)