PasteRack.org
Paste # 27805
2022-11-08 08:51:21

Fork as a new paste.

Paste viewed 806 times.


Embed:

  1. #lang htdp/isl
  2. (require 2htdp/image)
  3. (require 2htdp/universe)
  4.  
  5. ;; CONSTANTS:
  6.  
  7. (define ANGLE 45)
  8. (define SCALE 0.6)
  9. (define COLOR "black")
  10. (define CUTOFF 5)
  11.  
  12. ;; FUNCTIONS:
  13.  
  14. ;; Natural -> Image
  15. ;; produce fractal tree of n size
  16. (check-expect (tree CUTOFF)
  17.               (tr CUTOFF))
  18. (check-expect (tree (sub1 CUTOFF))
  19.               (tr (sub1 CUTOFF)))
  20. (check-expect (tree (/ CUTOFF SCALE))
  21.               (local [(define sub (tr CUTOFF))]
  22.                      (above (beside (rotate    ANGLE  sub)
  23.                                     (rotate (- ANGLE) sub))
  24.                             (tr (/ CUTOFF SCALE)))))
  25.  
  26. ;(define (tree n) empty-image) ;stub
  27.  
  28. (define (tree n)
  29.   ;; Base case: (<= n CUTOFF)
  30.   ;; Reduction step: (* n SCALE)
  31.   ;; Termination argument: Repeated division will eventually lead n to CUTOFF
  32.   ;;                       as long as n >= 0 and CUTOFF > 0
  33.   (cond [(<= n CUTOFF) (tr n)]
  34.         [else
  35.          (local [(define sub (tree (* n SCALE)))]
  36.            (above (beside (rotate    ANGLE  sub)
  37.                           (rotate (- ANGLE) sub))
  38.                     (tr n)))]))
  39.  
  40. ;; =============================
  41. (define (tr n)
  42.   (rectangle 2 n "solid" COLOR))
  43. ;; =============================
  44.  
  45. ;; MAIN:
  46.  
  47. (tree 200)

=>