PasteRack.org
Paste # 74815
2022-11-08 08:52:08

Fork as a new paste.

Paste viewed 940 times.


Embed:

  1. #lang htdp/asl
  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. #;#;#;
  17. (check-expect (tree CUTOFF)
  18.               (tr CUTOFF))
  19. (check-expect (tree (sub1 CUTOFF))
  20.               (tr (sub1 CUTOFF)))
  21. (check-expect (tree (/ CUTOFF SCALE))
  22.               (local [(define sub (tr CUTOFF))]
  23.                      (above (beside (rotate    ANGLE  sub)
  24.                                     (rotate (- ANGLE) sub))
  25.                             (tr (/ CUTOFF SCALE)))))
  26.  
  27. ;(define (tree n) empty-image) ;stub
  28.  
  29. (define (tree n)
  30.   ;; Base case: (<= n CUTOFF)
  31.   ;; Reduction step: (* n SCALE)
  32.   ;; Termination argument: Repeated division will eventually lead n to CUTOFF
  33.   ;;                       as long as n >= 0 and CUTOFF > 0
  34.   (cond [(<= n CUTOFF) (tr n)]
  35.         [else
  36.          (local [(define sub (tree (* n SCALE)))]
  37.            (above (beside (rotate    ANGLE  sub)
  38.                           (rotate (- ANGLE) sub))
  39.                     (tr n)))]))
  40.  
  41. ;; =============================
  42. (define (tr n)
  43.   (rectangle 2 n "solid" COLOR))
  44. ;; =============================
  45.  
  46. ;; MAIN:
  47.  
  48. (tree 200)

=>