"--------- BEGIN SUPPLIED CODE --------------"  
;; translate-posn: posn, num, num --> posn
;; Return the point which is a-point offset by (+x, +y).
;;
(define (translate-posn a-point x y)
  (make-posn (+ (posn-x a-point) x)
             (+ (posn-y a-point) y)))

"translate-posn tests:"
(define p34    (make-posn 30 40))
(define origin (make-posn 0 0))
(equal? (translate-posn p34 5 12) (make-posn 35 52))
(equal? p34 (translate-posn origin 30 40))
(equal? origin (translate-posn p34 -30 -40))


(define-struct circle (location radius color))
;
; A circle is:
;    (make-circle posn num symbol color)


;(Note how we've already given data defs for posns and colors, which is why we cavalierly refer to them as known data types.) 
; Examples of circles:
;
(define circ1  (make-circle p34  5 'red))    ; A little red dot.
(define circ23 (make-circle origin 40 'blue))    


(define-struct rectangle (location width height color))

;A rectangle is:
;    (make-rectangle posn num num color)
;
;Examples:
(define rect1 (make-rectangle (make-posn 100 100) 150 30 'yellow))
(define rect2 (make-rectangle (make-posn  200  300)  20  30 'red))



;; A shape is a structure that contains
;; - a circle, or
;; - a rectangle

" Examples of shapes:"
circ1
circ23
rect1
rect2

;; Template:
;;
#|
(define (shape-func a-shape)
  (cond [(circle? a-shape) ..(circle-location a-shape)..
         ..(circle-radius   a-shape)..
         ..(circle-color a-shape)..]
        [(rectangle? a-shape) ..(rectangle-location a-shape)..
         ..(rectangle-width a-shape)..
         ..(rectangle-height a-shape)..
         ..(rectangle-color a-shape)..]))
|#


;; translate-shape: Shape Num Num --> Shape
;; Return a shape which is like a-shape, but moved by (+x,+y).
;;
(define (translate-shape a-shape x y)
  (cond [(circle?    a-shape) (make-circle (translate-posn (circle-location a-shape) x y)
                                           (circle-radius a-shape)
                                           (circle-color a-shape))]
        [(rectangle? a-shape) (make-rectangle (translate-posn (rectangle-location a-shape) x y)
                                              (rectangle-width a-shape) 
                                              (rectangle-height a-shape)
                                              (rectangle-color a-shape))]))

"translate-shapes tests:"
(equal? (translate-shape (make-circle (make-posn 0 0) 4 'blue) 2 3) (make-circle (make-posn 2 3) 4 'blue))

(equal? (translate-shape (make-rectangle (make-posn 3 7) 4 14 'red) 0 1) (make-rectangle (make-posn 3 8) 4 14 'red))


"Canvas opened up now..."
(start 500 500) ; Opens a canvas to draw on.

;; draw-shape: Shape --> true
;; Draw a-shape on the current canvas, and return true.
;;
(define (draw-shape a-shape)
  (cond [(circle?    a-shape) 
         (draw-solid-disk (circle-location a-shape)
                          (circle-radius a-shape) 
                          (circle-color a-shape))]
        [(rectangle? a-shape) 
         (draw-solid-rect (rectangle-location a-shape)
                          (rectangle-width a-shape) 
                          (rectangle-height a-shape)
                          (rectangle-color a-shape))]))

" draw-shape test cases:"
(boolean=? true (draw-shape circ1))
(boolean=? true (draw-shape circ23))
(boolean=? true (draw-shape rect1))
(boolean=? true (draw-shape rect2))

; A constant, used for width of various bands, in part (b).
;
(define band-width 20)

#|
rectangle-tool: number -> true
purpose: to create a rectangle whose northwest corner is at ((* i band-width), 0), with width band-width and height (* i i)

|#
(define (rectangle-tool i)
  (make-rectangle (make-posn (* i band-width) 0)
                  band-width
                  (* i i)
                  'yellow))

"rectangle-tool tests:"
(equal? (rectangle-tool 0) (make-rectangle (make-posn 0 0) 20 0 'yellow))
(equal? (rectangle-tool 7) (make-rectangle (make-posn 140 0) 20 49 'yellow))


#|
circle-tool: number -> void
purpose: to create a circle centered at canvas position (150,150), with radius (* i band-width), and color red if i is odd or blue if i is even.
|#
(define (circle-tool i)
  (make-circle (make-posn 150 150)
               (* i band-width)
               (cond
                 [(odd? i) 'red]
                 [else 'blue])))

"circle-tool tests:"
(equal? (circle-tool 6) (make-circle (make-posn 150 150) 120 'blue))
(equal? (circle-tool 3) (make-circle (make-posn 150 150) 60 'red))

"--------- END SUPPLIED CODE --------------"  

;(1) 15pts total

;(a) 5pts

;; make-circles: list-of-number --> list-of-shape
;; Use circle-tool to make a circle for every number in the input list.
;;
(define (make-circles a-lon)
  (map circle-tool a-lon))

"make-circles test cases"
(equal? (make-circles (list 1 2 7))
        (list (circle-tool 1) (circle-tool 2) (circle-tool 7)))
(equal? (make-circles empty) empty)
(equal? (make-circles (list 42)) (list (circle-tool 42)))

;(b) 5pts

;; translate-shapes: list-of-shape, posn --> list-of-shape
;; Translate each shape in the list by the given amount.
;;
(define (translate-shapes a-los a-posn)
  (map (translate-by-posn a-posn)
       a-los))

;; translate-by-posn: posn --> (shape --> shape)
;; Produces a function that translates a shape by a-posn.
;; Helper function for translate-shapes.  [I originally put this in a local,
;; but it's also used in draw-many-shapes, so I put it a toplevel.]
;;
(define (translate-by-posn a-posn)
  (lambda (a-shape)
    (translate-shape a-shape (posn-x a-posn) (posn-y a-posn))))

"translate-by-posn test cases"
(define circ1_10_-5 (make-circle (make-posn 40 35) 5 'red))
(define rect1_4_10 (make-rectangle (make-posn 104 110) 150 30 'yellow))

(equal? circ1_10_-5
        ((translate-by-posn (make-posn 10 -5)) circ1))
(equal? rect1_4_10
        ((translate-by-posn (make-posn 4 10)) rect1))

"translate-shapes test cases"
(define test-posn (make-posn -20 1))
(equal? (list ((translate-by-posn test-posn) circ1)
              ((translate-by-posn test-posn) circ23)
              ((translate-by-posn test-posn) rect1)
              ((translate-by-posn test-posn) circ1_10_-5))
        (translate-shapes (list circ1 circ23 rect1 circ1_10_-5)
                          test-posn))

;(c) 5pts

; Let's do this for numbers and strings first, then write the general
; function.

;; max-list-num: list-of-nums --> num
;; Returns the maximum of a list of numbers.
;;
(define (max-list-num a-lon)
  (local [(define (max a b)
            (cond [(> a b) a]
                  [else b]))]
    (foldr max #i-inf.0 a-lon)))

"max-list-num test cases"
(equal? 341 (max-list-num (list 14 2 -500 341 3)))
(equal? #i-inf.0 (max-list-num empty))

;; max-list-str: list-of-strings --> string
;; Returns the maximum of a list of strings.
;; (Ordering of strings is determined by string>?, etc.  I don't know the
;; details, but does it matter?)
;;
(define (max-list-str a-los)
  (local [(define (max a b)
            (cond [(string>? a b) a]
                  [else b]))]
    (foldr max "" a-los)))

"max-list-str test cases"
(equal? "some sesame seeds" 
        (max-list-str (list "foo" "bar" "Alan Alda" "some sesame seeds")))
(equal? "" (max-list-str empty))

; Another issue: what should the base be for strings?  Would my choice
; (the empty list "") work in all cases?  In most cases?  Is there a "maximum
; string"?  What if you were writing min-list-str?  To answer these questions,
; here's an aside from Ian:

;If you really wanted to use this approach for
;min-string, you could make a def'n:
;
;(define-struct (maximum-string-sentinel)) ; A degenerate struct: no data inside.
;(define-struct (minimum-string-sentinel)) ; A degenerate struct.
;
;Data def'n: An extended-string is
;- a string, or
;- (make-minimum-string-sentinel), or
;- (make-maximum-string-sentinel)
;
;and then write your own functions "extended-string>?", etc.,
;which worked on these.
;Then you could use this function on a list of ordinary strings;
;for max-string, the return value could then distinguish between 
;an empty list, and a list that contained "".
;(People using this min/max function might want to explicitly
;check the result for this special sentinel value.)
;
;
;If you think about it, this is *exactly* what infinity is --
;mathematicans make up some new value called "infinity", and
;then extended the numeric functions like > and + to work
;for these augmented numbers!
;
;Note that if your input might involve infinities,
;then these no longer are reasonable sentinel values
;to return to say "there was no smallest number in the list",
;should it ever be important to distinguish this case.
;
;General rule: Never return a special sentinel value that
;might possibly be confused with a valid return value.

;(2) 10 pts total

;First, the invariant visitor stuff

(define-struct Visitor (fBase fInduct))

(define (execute a-list visitor param)
  (cond
    [(empty? a-list) ((Visitor-fBase visitor) a-list param)]
    [(cons? a-list) ((Visitor-fInduct visitor) a-list param)]))

;(a) 5 pts

;; count-rev-visitor
;; Counts the number of elements in a list using reverse accumulation.
;;
(define count-rev-visitor
  (make-Visitor
   ;; Empty case: list, any --> number
   (lambda (a-list param) 0)
   ;; Cons case: list, any --> number
   (lambda (a-list param) 
     (+ 1 (execute (rest a-list) count-rev-visitor param)))))

"count-rev-visitor test cases"
(equal? 4 (execute (list 1234 3 'foo 50) count-rev-visitor 'dummy))
(equal? 0 (execute empty count-rev-visitor 'dummy))

;(b) 5 pts

;; count-forw-visitor
;; Counts the number of elements in a list using forward accumulation.
;;
(define count-forw-visitor
  (make-Visitor
   ;; Empty case: list, number --> 0
   (lambda (a-list acc) 0)
   ;; Cons case: list, number --> number
   (lambda (a-list acc)
     (execute (rest a-list) count-forw-visitor-help 1))))

;; count-forw-visitor-help
;; Helper visitor that counts the elements of a list.
;;
(define count-forw-visitor-help
  (make-Visitor
   ;; Empty case: list, number --> number
   (lambda (a-list acc) acc)
   ;; Cons case: list, number --> number
   (lambda (a-list acc)
     (execute (rest a-list) count-forw-visitor-help (+ 1 acc)))))

"count-forw-visitor test cases"
(equal? 4 (execute (list 123 "boogie" 4 'falafel) count-forw-visitor 'dummy))
(equal? 0 (execute empty count-forw-visitor 'dummy))

;(3) 25 pts total

;(a) 10 pts

;; filter-<0-visitor
;; Removes all negative numbers from a list of numbers.
;;
(define filter-<0-visitor
  (make-Visitor
   ;; Empty case: list, any --> empty
   (lambda (a-list param) empty)
   ;; Cons case: list, any --> a-list
   (lambda (a-list param)
     (local [(define filtered-rest 
               (execute (rest a-list) filter-<0-visitor param))]
       (cond [(< (first a-list) 0)  filtered-rest]
             [(>= (first a-list) 0) (cons (first a-list) filtered-rest)])))))

"filter-<0-visitor test cases"
(equal? (list 20 0 123)
        (execute (list 20 -15 0 123 -20 -1) filter-<0-visitor 'dummy))
(equal? empty
        (execute empty filter-<0-visitor 'dummy))

;(b) 5 pts

;; make-comparer: number --> (number --> boolean)
;; Given n, return a function that returns true if input-num is greater than
;; n.
(define (make-comparer n)
  (lambda (input-num) (> input-num n)))

;(c) 10 pts

;; filter-visitor
;; Filters out elements of a list on which the given comparator function
;; returns true.
;;
(define filter-visitor
  (make-Visitor
   ;; Empty case: list-of-any, (any --> boolean) --> empty
   (lambda (a-list comp-fun) empty)
   ;; Cons case: list-of-any, (any --> boolean) --> list-of-any
   (lambda (a-list comp-fun)
     (local [(define filtered-rest
               (execute (rest a-list) filter-visitor comp-fun))]
       (cond [(comp-fun (first a-list)) filtered-rest]
             [else (cons (first a-list) filtered-rest)])))))

"filter-visitor test cases"
(equal? (list 30 234)
        (execute (list 30 -4 234 0 -132 -1 4) filter-visitor 
                 (lambda (a) (< a 6))))
(equal? (list "aardvark" "k" "banana" "moose" "Crayola" "Teflon") 
        (execute 
         (list "aardvark" "k" "banana" "moose" 
               "zipper" "Crayola" "terse" "Teflon")
         filter-visitor (lambda (a) (string>? a "nincompoop"))))

;(4) 10 pts

;;foldrn: (natnum any1 --> any1) any1 natnum --> any1
;;foldr for natural numbers 
(define (foldrn f base n)
  (cond
    [(zero? n) base]
    [(< 0 n) (f n (foldrn f base (sub1 n)))]))

"Foldrn test cases:"
(= 42 (foldrn + 42 0))
(= 15 (foldrn + 0 5))
(equal? (list 10 9 8 7 6 5 4 3 2 1) 
        (foldrn (lambda (n rr)
                  (cons n rr))
                empty
                10))

;(5) 15 pts

;; my-map: (alpha --> beta), list-of-alpha --> list-of-beta
;; A fat-free map substitute. :-)  Has the same effect as the higher-level
;; function map.  Implemented in terms of foldr.
;;
(define (my-map a-func a-list)
  (foldr (lambda (a b) (cons (a-func a) b)) empty a-list))

"my-map test cases:"
(equal? (list 24 -449 2.5 4 101)
        (my-map add1 (list 23 -450 1.5 3 100)))
(equal? (list false false true false false true)
        (my-map (lambda (a) (= a 42)) (list 30 0 42 -42 20 42)))
; Everyone knows about the fortune cookie thing, right?
(define fortune-cookies
  (list 
   "you are very expressive and positive in word, act, and feeling"
   "a helpful spirit will bring you great fortune"
   "your heart is pure and your mind is clear"
   "you are admired for your generosity"))
(define add-in-bed
  (lambda (s) (string-append s " in bed")))
(equal?
 (map add-in-bed fortune-cookies)
 (my-map add-in-bed fortune-cookies))

;(6) 15 pts

;From lecture:

(define-struct FoldInp (f base))

(define foldrVisitor
  (make-Visitor
   (lambda (a-list foldInp)
     (FoldInp-base foldInp))
   (lambda (a-list foldInp)
     ((FoldInp-f foldInp)
      (first a-list) 
      (execute (rest a-list) foldrVisitor foldInp)))))

;end from lecture

;; map-visitor
;; Implements the map function as a foldr visitor.
;;
(define map-visitor
  (local [;; visitor-case: list-of-a, (a, list-of-b --> list-of-b) 
          ;;                 --> list-of-b
          ;; Same for both cases.
          ;;
          (define visitor-case
            (lambda (a-list a-func)
              (local [;; foldr-func: a, list-of-b --> list-of-b
                      ;; The function given to foldr to implement map.
                      ;;
                      (define foldr-func
                        (lambda (a b) (cons (a-func a) b)))]
                (execute a-list foldrVisitor 
                         (make-FoldInp foldr-func empty)))))]
    (make-Visitor
     visitor-case
     visitor-case)))

"map-visitor test cases"
(equal? (list 2 13 5 21 6) 
        (execute (list 1 12 4 20 5) map-visitor add1))
(equal? empty 
        (execute empty map-visitor (lambda (a) (cons a empty))))
(equal? (list false false true false false true)
        (execute (list 30 0 42 -42 20 42) map-visitor (lambda (a) (= a 42))))



;(7) 15 pts

;;lastList is a Visitor that returns
;; the remainder of the input parameter list, a-list,
;; that when the first elements corresponding to the 
;; elements of the host list are removed.
;; If a-list is shorter than the host, then empty is returned.
(define lastList
  (make-Visitor
   (lambda (host a-list) a-list)
   (lambda (host a-list)
     (execute a-list
              (make-Visitor
               (lambda (host2 nu)
                 host2)
               (lambda (host2 nu)
                 (execute (rest host) lastList (rest host2))))
              null))))

"lastList test cases:"
(equal? (list 1 2 3) (execute empty lastList (list 1 2 3)))
(equal? (list 3) (execute (list 'a 'b ) lastList (list 1 2 3)))
(equal? (list 2 'howdy 3 "yahoo y'all!") (execute (list 'a 42 'b ) lastList (list 1 'z  'x 2 'howdy 3 "yahoo y'all!")))
(equal? empty (execute (list 'a 'b 'c 'd) lastList (list 1 2 3)))


;(8) (15 pts extra)

;; foldl-visitor
;; The foldl function implemented as a visitor.
;;
(define foldl-visitor
  (make-Visitor
   ;; Empty case
   (lambda (a-list foldInp)
     (FoldInp-base foldInp))
   ;; Cons case
   (lambda (a-list foldInp)
     (local [;; structure for helper visitor
             ;; Includes function and accumulator.
             ;;
             (define-struct FoldHelpInp (f acc))
             
             ;; Helper visitor.
             ;;
             (define foldl-visitor-helper
               (make-Visitor
                ;; Empty case.
                (lambda (a-list foldHelpInp)
                  (FoldHelpInp-acc foldHelpInp))
                ;; Cons case.
                (lambda (a-list foldHelpInp)
                  (local [(define f (FoldHelpInp-f foldHelpInp))]
                    (execute (rest a-list) 
                             foldl-visitor-helper
                             (make-FoldHelpInp 
                              f 
                              (f (first a-list) 
                                 (FoldHelpInp-acc foldHelpInp))))))))]
       (execute a-list foldl-visitor-helper 
                (make-FoldHelpInp (FoldInp-f foldInp) (FoldInp-base foldInp)))))))

;; Note: this kind of accumulator, which work by repeatedly applying
;; functions, is called a "continuation."  Guess what?  Remember tail-recursive
;; functions?  It's possible to make any function tail-recursive, by using a
;; continuation.

;; SW notes:  the above foldHelpInp structure is unnecessary because foldInp is in scope for 
;; the helper visitor, so the inductive case function does not need to be passed as an 
;; input parameter.   See the simpler solution below.

"foldl-visitor test cases"
; sum up a list with + and 0
(equal? -11
        (execute (list -50 2 30 5 2) foldl-visitor (make-FoldInp + 0)))

; use an arbitrary function and a specific base.
(equal? 'all-your-base
        (execute empty foldl-visitor 
                 (make-FoldInp (lambda (a b) 'arbitrary) 'all-your-base)))

; Reverse a list with cons and empty
(equal? (reverse (list 'a 'b 'c 'd 'e 'f 'g))
        (execute (list 'a 'b 'c 'd 'e 'f 'g) foldl-visitor
                 (make-FoldInp cons empty)))


;; --- a simpler solution ----

;; implements foldl as a visitor
(define foldlVisitor
  (make-Visitor
   (lambda (a-list foldInp)
     (FoldInp-base foldInp))
   (lambda (a-list foldInp)
     (local
         [(define helper
            (make-Visitor
             (lambda (a-list acc)
               acc)
             (lambda (a-list acc)
               (execute (rest a-list) helper ((FoldInp-f foldInp) (first a-list) acc)))))]
       (execute a-list helper (FoldInp-base foldInp))))))


"foldlVisitor test cases:"
(equal? (foldr + 0 empty) (execute empty foldlVisitor (make-FoldInp + 0)))
(equal? (foldr + 0 (list 1 2 3 4 5)) (execute (list 1 2 3 4 5) foldlVisitor (make-FoldInp + 0)))
(equal? (foldr * 1 (list 1 2 3 4 5)) (execute (list 1 2 3 4 5) foldlVisitor (make-FoldInp * 1)))
(equal? (foldl cons empty (list 1 2 3 4 5))
        (execute (list 1 2 3 4 5) foldlVisitor (make-FoldInp cons empty)))

; sum up a list with + and 0
(equal? -11
        (execute (list -50 2 30 5 2) foldlVisitor (make-FoldInp + 0)))

; use an arbitrary function and a specific base.
(equal? 'all-your-base
        (execute empty foldlVisitor 
                 (make-FoldInp (lambda (a b) 'arbitrary) 'all-your-base)))

; Reverse a list with cons and empty
(equal? (reverse (list 'a 'b 'c 'd 'e 'f 'g))
        (execute (list 'a 'b 'c 'd 'e 'f 'g) foldlVisitor
                 (make-FoldInp cons empty)))


;(9) (15 pts extra)

; from previous homework:

;; Sorter is structure that holds the split and join functions needed for 
;; template pattern sorting.
;; where split and join have the following abstract contracts
;; split: list-of-any --> (list list-of-any list-of-any)
;; join: list-of-any list-of-any --> list-of-any
;; (make-Sorter function function)
(define-struct Sorter (split join))

;;unzip: loa --> tuple
;;unzip returns a list of two lists, with each having half of the members of the given list
(define (unzip a-list)
  (cond [(empty? a-list) (list empty empty)]
        [(cons? a-list)   
         (local
             [(define unzipped (unzip (rest a-list)))]
           (list (cons (first a-list) (second unzipped))
                 (first unzipped)))]))

;; merge:  list-of num list-of-num --> list-of-num
;; Takes two list-of-nums already sorted in descending order
;; and creates a new list with all the values of both lists combined
;; in descending order.
(define (merge lon1 lon2)
  (local
      [;; merge_help:  cons list-of-num --> list-of-num
       ;; Takes two list-of-nums already sorted in descending order
       ;; and creates a new list with all the values of both lists combined
       ;; in descending order.  lon1 is assumed to be cons.
       ;; Merge_help only checks lon2 for empty/cons and thus uses merge to check both
       ;; lon1 and lon2 when needed.
       (define (merge_help lon1 lon2)
         (cond 
           [(empty? lon2) lon1]
           [(cons? lon2) (cond
                           [(> (first lon1) (first lon2)) (cons (first lon1) (merge (rest lon1) lon2))]
                           [else (cons (first lon2) (merge lon1 (rest lon2)))])]))]
    (cond 
      [(empty? lon1) lon2]
      [(cons? lon1) (merge_help lon1 lon2)])))

(define merger (make-Sorter unzip merge))

;; insert-split: lon -> lon, lon
;; splits one list into two lists with the first list containing the first number in the 
;; original list and the second list contains the rest of the numbers in the orginal
;; list

(define (insert-split lon)  
  (cond [(empty? lon) (list empty empty)]
        [else (list (list (first lon)) (rest lon))]))

;; insert-join: lon, lon -> lon
;; creates a list of numbers in descending order
(define (insert-join lon1 lon2)
  (cond
    [(empty? lon2) lon1]
    [(cons? lon2) 
     (cond  [(> (first lon2) (first lon1)) (cons (first lon1) lon2)]
            [else 
             (cons (first lon2) ((Sorter-join insertioner) lon1 (rest lon2)))])]))

;; insertion sort

(define insertioner (make-Sorter insert-split insert-join))

; end from previous homework

;; sort-visitor
;; Sorts a list using a given Sorter.
(define sort-visitor
  (make-Visitor
   ;; Empty case: list, Sorter --> list
   (lambda (a-list sorter) empty)
   ;; Cons case: list, Sorter --> list
   (lambda (a-list sorter)
     (cond [(empty? (rest a-list)) a-list]
           [(cons? (rest a-list))
            (local [(define splitter ((Sorter-split sorter) a-list))]
              ((Sorter-join sorter)
               (execute (first splitter) sort-visitor sorter)
               (execute (second splitter) sort-visitor sorter)))]))))

"sort-visitor test cases"
(define some-list (list 200 1 -40 3 4 7 10))
; For some reason, from the previous homework, 'insertioner' creates an
; ascending list, while 'merger' creates a descending list.  It's okay, they
; both sort.
(define sorted-list-up (list -40 1 3 4 7 10 200))
(define sorted-list-down (list 200 10 7 4 3 1 -40))
(equal? sorted-list-down (execute some-list sort-visitor merger))
(equal? sorted-list-up (execute some-list sort-visitor insertioner))