Advertisement
Guest User

Untitled

a guest
Dec 7th, 2016
70
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.94 KB | None | 0 0
  1. (require cs111/define-struct)
  2. (require 2htdp/image)
  3.  
  4. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5. ;; Structural Inheritance
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7.  
  8. ;; Here's the class hierarchy we'll be building:
  9. ;;
  10. ;; Shape
  11. ;; __|___
  12. ;; | |
  13. ;; Circle Rectangle
  14.  
  15. ;; A Shape is an ABSTRACT base type.
  16. ;;
  17. ;; Properties:
  18. ;; - color, a valid Racket color string
  19. ;;
  20. ;; Methods:
  21. ;; - render : Shape -> Image, a function to draw the shape
  22. ;; - area : Shape -> Number, a function to compute the area of a shape
  23. ;;
  24. ;; Abstract just means it's a template for subtypes, but
  25. ;; we never call (make-shape ...) directly.
  26. (define-struct shape [color]
  27. #:methods
  28.  
  29. ; render : Shape -> Image
  30. (define (render sh)
  31. ; Nothing to render right now because the shape has no size.
  32. empty-image)
  33.  
  34. ; area : Shape -> Number
  35. (define (area sh)
  36. ; Nothing to compute right now because the shape has no size.
  37. ; We'll return -1 to simplify things.
  38. -1))
  39.  
  40. ;; Now let's define some subtypes of Shape.
  41.  
  42. ;; A Circ is a subtype of Shape.
  43. ;;
  44. ;; Properties:
  45. ;; - color, a valid Racket color string (inherited from Shape)
  46. ;; - radius, a positive real number
  47. ;;
  48. ;; Methods:
  49. ;; - render : Shape -> Image (inherited from Shape)
  50. ;; - area : Shape -> Number (inherited from Shape)
  51. ;;
  52. ;; Note that we're calling our type `circ` because `circle`
  53. ;; is already defined by the 2htdp/image library.
  54. (define-struct (circ shape)
  55. ;; (circ shape) tells Racket we're inheriting properties and
  56. ;; methods from the Shape type, so we don't need to list
  57. ;; those inherited properties explicitly.
  58. ;;
  59. ;; We just need to add the new, Circ-specific property.
  60. [radius]
  61.  
  62. #:methods
  63.  
  64. ;; render : Shape -> Image
  65. ;; Remeber that a Circ is a Shape (because of inheritance),
  66. ;; so we can call `render` on a Circ.
  67. (define (render c)
  68. ;; Draw a circle with the same old function we know and love
  69. (circle (circ-radius c)
  70. "solid"
  71. ;; Remember, `color` is an INHERITED property of the base
  72. ;; type Shape, so we need to use `shape-color` instead of
  73. ;; `circ-color` to get it
  74. (shape-color c)))
  75.  
  76. ;; area : Shape -> Number
  77. (define (area c)
  78. (* pi
  79. (sqr (circ-radius c)))))
  80.  
  81. ;; Let's make a Circ
  82. (define small-circ
  83. ;; Notice the order of the property values:
  84. (make-circ
  85. ;; (1) Inherited properties, in order
  86. "green"
  87. ;; (2) Subtype properties, in order
  88. 10))
  89.  
  90. ;; Let's try the Circ's `render` function
  91. ;; Notice how with methods, we don't use the typical
  92. ;; <StructType>-<FieldName> notation.
  93. ;; i.e. instead of (circ-render ...) we just use (render ...)
  94. (render small-circ)
  95. ;; .
  96.  
  97. (render (make-circ "blue" 100))
  98. ;; .
  99.  
  100. ;; Area?
  101. (area small-circ)
  102. ;; #i314.1592653589793
  103.  
  104. (area (make-circ "red" 75))
  105. ;; #i17671.458676442588
  106.  
  107. ;; A Rect is a subtype of Shape.
  108. ;;
  109. ;; Properties:
  110. ;; - color, a valid Racket color string (inherited from Shape)
  111. ;; - width, a positive real number
  112. ;; - length, a positive real number
  113. ;;
  114. ;; Methods:
  115. ;; - render : Shape -> Image (inherited from Shape)
  116. ;; - area : Shape -> Number (inherited from Shape)
  117. ;;
  118. ;; Note that we're calling our type `rect` because `rectangle`
  119. ;; is already defined by the 2htdp/image library.
  120. (define-struct (rect shape)
  121. ;; Additional fields: width, length
  122. [width length]
  123.  
  124. #:methods
  125.  
  126. ;; render : Shape -> Image
  127. (define (render r)
  128. (rectangle (rect-width r)
  129. (rect-length r)
  130. "solid"
  131. ;; Remember, `color` is an inherited property of Shape
  132. ;; so we use `shape-color`, not `rect-color`
  133. (shape-color r)))
  134.  
  135. ;; area : Shape -> Number
  136. (define (area r)
  137. (* (rect-width r)
  138. (rect-length r))))
  139.  
  140. ;; Make some Rects
  141. (define big-rect
  142. (make-rect
  143. ;; (1) Inherited properties, in order
  144. "red"
  145. ;; (2) Subtype properties, in order
  146. 150 100))
  147.  
  148. (define actually-square
  149. (make-rect "black" 50 50))
  150.  
  151. ;; Notice that `render` intelligently does the right thing, depending
  152. ;; on whether we pass a Rect or a Circ
  153. (render big-rect)
  154. ;; .
  155.  
  156. (render actually-square)
  157. ;; .
  158.  
  159. ;; Same with `area`
  160. (area big-rect)
  161. ;; 15000
  162. (area actually-square)
  163. ;; 2500
  164.  
  165. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  166.  
  167. ;; Remember, we're dealing with regular structs and functions, so
  168. ;; all the normal stuff applies.
  169.  
  170. (require cs111/iterated)
  171.  
  172. "Using iterated-above..."
  173. (iterated-above
  174. ;; render : Shape -> Image is still a normal image-making function
  175. (lambda (n) (render (make-rect "green" (* 20 n) (* 20 n))))
  176. 5)
  177. ;; .
  178.  
  179. ;; We can do everything as usual with structs:
  180. (circ? big-rect) ; false
  181. (circ? small-circ) ; true
  182. (circ? (make-rect "blue" 10 20)) ; false
  183. (circ? "hello") ; false
  184.  
  185. "Original big-rect"
  186. (render big-rect)
  187. ;; .
  188.  
  189. ;; Set! struct properties as usual
  190. (set-rect-width! big-rect
  191. (* 2
  192. ;; Access properties as usual
  193. (rect-width big-rect)))
  194.  
  195. "After doubling width:"
  196. (render big-rect)
  197. ;; .
  198.  
  199. ;; Notice that we always treat inherited properties
  200. ;; as attached to their original types, not the
  201. ;; descendant types.
  202. (set-shape-color! ; Not `set-rect-color!`
  203. big-rect "yellow")
  204.  
  205. "After changing color:"
  206. (render big-rect)
  207. ;; .
  208.  
  209. ;; Lists of structs work as usual
  210. (define shapes
  211. (list
  212. (make-circ "firebrick" 30)
  213. (make-rect "yellow" 40 50)
  214. (make-circ "blue" 20)))
  215.  
  216. (define rendered-shapes (map render shapes))
  217.  
  218. "Images rendered from a list of shapes"
  219. rendered-shapes
  220. ;; . . .
  221.  
  222. "Result of folding all images into one"
  223. (foldl overlay empty-image rendered-shapes)
  224. ;; .
  225.  
  226. ;; Filter shapes by size
  227. (define large-shapes
  228. (filter
  229. ;; Shape -> Boolean
  230. (lambda (s) (>= (area s) 2000))
  231. shapes))
  232.  
  233. "Shapes with areas greater than or equal to 2000 units"
  234. (map render large-shapes)
  235. ;; #<list: . .>
  236.  
  237. ;; Imperative functions and stuff work too
  238. (for-each
  239. ;; Shape -> Void
  240. ;; Side effect: sets the color of the given Shape to green
  241. (lambda (s) (set-shape-color! s "green"))
  242. shapes)
  243.  
  244. "Shapes after we made them green"
  245. (map render shapes)
  246. ;; #<list: . . .>
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement