(require 2htdp/universe)
(require 2htdp/image)
; 
;  Problem 1:
;  
;  Given the following define-struct statement, name all the func-  
;  tions that are created when this line is executed, give 
;  their contracts, and identify them as constructor, accessor, 
;  mutator, and type checker.
;  
;      (define-struct animal (family genus species))
;      
; family genus and species are strings.
; 
; --------------------
; ANSWER:
; 
; Constructor: 
; (make-animal string string string) -> animal
; 
; Accessors:
; (animal-family animal) -> string
; (animal-genus animal) -> string
; (animal-species animal) -> string
; 
; Mutators:
; (set-animal-family! animal string) -> void
; (set-animal-genus! animal string) -> void
; (set-animal-species! animal string) -> void
; 
; Type checker:
; (animal? anything) -> boolean
;  


; Problem 2
; 
; Draw the binary search tree that results from inserting          
; the following numbers (as btnodes), in the order given, 
; into an initially empty binary search tree: 
;            55, 25, 89, 77, 65, 12, 5, 14, 90.
;            
; Give the numbers contained in each of the following nodes:
; 
; The root of the BST-  55
; 
; The internal nodes of the BST- 55 25 89 77 12
; 
; The leaves of the BST- 65 5 14 90
; 

#|

                         Root: 55
           LeftCh: 25                  RightCh: 89                  
        LeftCh: 12                 LeftCh: 77  RightCh: 90          
    LeftCh: 5  RightCh: 14      LeftCh: 65                       
|#

; Problem 3
; 
; Write the function PREFIX-SUM that consumes a list of numbers
; and produces a list of numbers in which every number except  
; the first is replaced by the sum of the previous number (which    
; may itself be a sum) in the list added to its value.
; 
; The first number on the list should be added to the output       
; list unchanged.
; 
; Examples to help clarify the problem:
;  
;  > (prefix-sum '(9 2 4 2 8))     ==> (9 11 15 17 25)
;  
;  > (prefix-sum '(1 2 3 4 5 6 7)) ==> (1 3 6 10 15 21 28)
;  
;  > (prefix-sum '(1 2 3 4))       ==> (1 3 6 10)
;  
;  > (prefix-sum '(1 2))           ==> (1 3)
;  
;  > (prefix-sum '())              ==> ()
;  
;  > (prefix-sum '(5))             ==> (5)
; 
; 

;; Contract: (prefix-sum list-of-numbers) -> list-of-numbers
;; Header:   (define prefix-sum (lambda (lin) ... ))
;; Purpose:  Make a prefix sum list from lin. 

;; Pre-function tests:
(check-expect (prefix-sum '(9 2 4 2 8)) '(9 11 15 17 25))
(check-expect (prefix-sum '(1 2 3 4 5 6 7)) '(1 3 6 10 15 21 28))
(check-expect (prefix-sum '(1 2 3 4)) '(1 3 6 10))
(check-expect (prefix-sum '(1 2)) '(1 3))
(check-expect (prefix-sum '(5)) '(5))
(check-expect (prefix-sum '()) '())

;; Function definition: (variation 1)
(define prefix-sum 
  (lambda (lin)
    (local
      [(define helper 
         (lambda (pos lacc)
           (cond
             ;; Base case:  pos is at end of list, return accumulator
             [(= pos (length lin)) lacc]
             ;; Recursive case 1: pos is 0, leave first element as it is
             ;; USE APPEND OF LACC ONTO A SINGLE ELEMENT LIST
             ;; TO KEEP LIST IN ORIGINAL ORDER
             [(= pos 0) (helper (add1 pos) (append lacc (list (first lin))))]
             ;; Recursive case 2: pos > 0 so add element at pos-1 in
             ;; acc to element at pos in lin 
             [else
              (helper 
               (add1 pos) 
               ;; USE APPEND OF LACC ONTO A SINGLE ELEMENT LIST
               ;; TO KEEP LIST IN ORIGINAL ORDER
               (append lacc (list (+ (list-ref lacc (sub1 pos)) 
                                     (list-ref lin pos)))))])))]
      ;; Original call to helper
      (helper 0 empty))))

; 
;  Problem 4:
;  
;  Develop the function swap-posn, which consumes a posn structure  
;  and swaps the values in the two fields.
;  
;  First, write a non-mutating function called swap-posn and then 
;  write a mutating function called swap-posn!.
;  


; Contract: (swap-posn posn) -> posn
; Header:   (define swap-posn (lambda (p) ...))
; Purpose:  swap x and y fields in a single posn by making new posn

; Pre-function tests:
(check-expect (swap-posn (make-posn 1 55)) (make-posn 55 1))

; Function definition (non-mutating version)
(define swap-posn
  (lambda (p)
    (make-posn (posn-y p) (posn-x p))))

; Contract: (swap-posn! posn) -> posn
; Header:   (define swap-posn! (lambda (p) ...))
; Purpose:  swap x and y fields in a single posn by mutating input posn

; Pre-function tests:
(check-expect (swap-posn! (make-posn 1 55)) (swap-posn (make-posn 1 55)))

; Function definition (non-mutating version)
(define swap-posn!
  (lambda (p)
    (local
      [(define temp (posn-x p))]
      (begin
        (set-posn-x! p (posn-y p))
        (set-posn-y! p temp)
        p))))

; 
;  Problem 5:
;  
;  Develop the function double-all-ohs which consumes a string 
;  and adds an extra o for each lowercase or uppercase "o" in the   
;  string.
;  
;  Examples to help clarify the problem:
;  
;  > (double-all-ohs "stop")   ==> "stoop"
;  
;  > (double-all-ohs "Onward!")  ==> "OOnward!"
;  
;  > (double-all-ohs "")   ==> ""
;  
;  > (double-all-ohs "hello world")     ==> "helloo woorld"
;  
;  > (double-all-ohs "cat")     ==> "cat"
;  


;; Contract: (double-all-ohs string) -> string
;; Header:   (define double-all-ohs (lambda (str) ... ))
;; Purpose:  create new string with two #\o or #\O for every #\o or
;;           #/O in input string

;; Pre-function tests:
(check-expect (double-all-ohs "stop") "stoop")
(check-expect (double-all-ohs "Oh") "OOh")
(check-expect (double-all-ohs "") "")

;; Function definition:
(define double-all-ohs
  (lambda (str)
    (local
      [(define double-o-help
         (lambda (pos sacc)
           (cond
             ;; base case: pos is greater than the position of the last char
             ;;            in str, return the accumulator
             [(= pos (string-length str)) sacc]
             ;; recursive case 1: char at pos in str is an O
             [(char-ci=? (string-ref str pos) #\o)
              (double-o-help 
               (add1 pos)
               (if (char-upper-case? (string-ref str pos))
                   (string-append sacc "OO")
                   (string-append sacc "oo")))]
             ;; recursive case 2: char at pos in str is not an O
             [else
              (double-o-help 
               (add1 pos) 
               (string-append sacc (string (string-ref str pos))))])))]
      ;; initial call to helper passes the first position in the string and 
      ;; empty string for acc
      (double-o-help 0 ""))))

         
; 
; Problem 6
; 
; Write the function COUNT-WORDS that consumes a phrase 
; (a string) and returns the number of words in the given     
; string. You can assume that words are separated by any non-       
; alphabetic characters.
; 
; > (count-words "This is a sentence.") => 4
; 
; > (count-words "a b c d e f g h i") => 9
; 
; > (count-words "") => 0
; 
; Hint (IF YOU ARE HAVING PROBLEMS WRITING THIS 
; FUNCTION): Use the char-alphabetic? and substring 
; functions and an external helper function to search 
; for the position of the next non-alphabetic char in 
; the input string.
; 
; 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Contract: (count-words string) => number
;; Header:   (define count-words (lambda (str) ... ))
;; Purpose:  returns the number of words in the given string, where a word is
;;           delineated by any non-alpha characters.
;; Pre-function tests: 
(check-expect (count-words "  This is a     sentence.") 4)
(check-expect (count-words "a b c ...d e f    g h i") 9) 
(check-expect (count-words "a c b  a....d e") 6)
(check-expect (count-words "") 0)
(check-expect (count-words "A man, a plan, a canal: Panama!") 7)
(check-expect 
 (count-words "Wow! This has a lot of punctuation, does it not? Yup.") 11) 

#|
Strategy (algorithm for count-words): 
1. If at end of the string, return acc (word count)
2. Else if the current character is not alphabetic
   a. Call helper function to skip over all non-alpha characters
      until it finds the next alpha
3. Else the current character is alphabetic
   a. Call helper function to skip over all alpha characters 
      until it finds the next alpha.
   b. Increment word count
|#

;; Contract: (find-next-alph string number) -> number
;; Header:   (define find-next-alpha (lambda (str num) ... ))
;; Purpose:  Starting at a non-alpha character, return the index of the 
;;           next alpha char
;; Helper function that skips over non-alphabetic characters until it finds
;; an alphabetic character or until the end of the string.
;; Pre-function tests:
(check-expect (find-next-alph "....4..ab" 0) 7)
(check-expect (find-next-alph "  Sup?" 0) 2)
(check-expect (find-next-alph "..." 0) 3)

;; Function definition:
(define find-next-alph 
  (lambda (str num)
    (cond
      ;; Base case 1:  At end of str, return num
      [(= num (string-length str)) num]
      ;; Base case 2:  At next alpha char, return num
      [(char-alphabetic? (string-ref str num)) num]
      ;; Recursive case: Keep looking for next alpha char 
      [(not (char-alphabetic? (string-ref str num)))
       (find-next-alph str (add1 num))])))

;; Contract: (find-next-nc string number) -> number
;; Header:   (define find-next-nc (lambda (str num) ... ))
;; Purpose:  Starting at an alpha character, return the index of the 
;;           next non-alpha char
;; Helper function that skips over alphabetic characters until it finds
;; a non-alphabetic character or until the end of the string.
;; Pre-function tests:
(check-expect (find-next-nc "Have you seen Scooter?" 0) 4)
(check-expect (find-next-nc "Sup?" 0) 3)
(check-expect (find-next-nc "ababababa c" 0) 9)
(check-expect (find-next-nc "Supper" 0) 6)

;; Function definition:
(define find-next-nc 
  (lambda (str num)
    (cond
      ;; Base case 1:  At end of str, return num
      [(= num (string-length str)) num]
      ;; Base case 2:  At next non-alpha char, return num
      [(not (char-alphabetic? (string-ref str num))) num]
      ;; Recursive case: Keep looking for next non-alpha char
      [(char-alphabetic? (string-ref str num))
       (find-next-nc str (add1 num))])))

;; Function definition:
(define count-words 
  (lambda (strng)
    (local 
      [(define (helper str num acc) 
         (cond
           ;when num = length of the string,
           ;return the accumulator
           [(= num (string-length str)) acc]
           ;if the character at num is not alphabetic, find the next alpha
           ;char and do not increment the accumulator
           [(not (char-alphabetic? (string-ref str num)))
            ;; find the substring in str that starts at the next alpha char
            (helper (substring str (find-next-alph (substring str num) num)) 
                    0 acc)]
           ;if the character at num is alphabetic, find the next non-alpha
           ;char and increment the accumulator
           [else
            (helper (substring str (find-next-nc (substring str num) num)) 
                    0 (add1 acc))]))] 
      ;calls helper
      (helper strng 0 0)))) 

; 
; Problem 7
; 
; Write the function LIST-WORDS that consumes a phrase 
; (a string) and returns each word in the given string as
; a list of strings.
; 
; You can assume that words are separated by any non-
; alphabetic characters.
; 
; > (list-words "This is a sentence.") => 
;                            ("This" "is" "a" "sentence")
; > (list-words "") => ()
; 
; > (list-words "Four score and seven years ago") =>
;             ("Four" "score" "and" "seven" "years" "ago")
;                       
; Hint: You may be able to re-use an external helper 
; function you wrote for problem 8 in the solution for this   
; problem.
;                      


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Contract: (find-next-nonc string number string) -> string
;; Header:   (define find-next-nonc (lambda (str num acc) ... ))
;; Purpose:  Starting at an alpha character, return the next sequence of 
;;           alpha characters as a string

;; Helper function to accumulate characters until next non-alphabetic 
;; character is found.
;; Pre-function tests:
(check-expect (find-next-nonc "Here is a string!" 0 "") "Here")
(check-expect (find-next-nonc "Here is a string!" 5 "") "is")
(check-expect (find-next-nonc "Here is a string!" 10 "") "string")
;; Function definition:
(define find-next-nonc 
  (lambda (str num acc)
    (cond
      ;; Base case 1:  At end of str, return acc
      [(= num (string-length str)) acc]
      ;; Base case 2:  At next non-alpha char, return num
      [(not (char-alphabetic? (string-ref str num))) acc]
      ;; Recursive case: Keep looking for next non-alpha char
      [(char-alphabetic? (string-ref str num))
       (find-next-nonc str (add1 num) 
                       (string-append acc (string (string-ref str num))))])))  

;; Contract: (list-words string)-> list of strings
;; Helper:   (define list-words (lambda (str) ... ))
;; Purpose:  Return every word in str as a string in a list

;; Pre-function tests:
(check-expect (list-words "This is a sentence.") '("This" "is" "a" "sentence"))
(check-expect (list-words "Four score and seven years ago")
            '("Four" "score" "and" "seven" "years" "ago"))
(check-expect (list-words "") '())
(check-expect 
 (list-words "four score and seven years ago our ancestors brought forth") 
 '("four" "score" "and" "seven" "years" "ago" "our" "ancestors" "brought" 
          "forth"))

;; Function definition:
(define list-words 
  (lambda (str)
    (local 
      [(define (helper str pos lacc) 
         (cond
           ;when pos = end of the string, return the accumulator
           [(= pos (string-length str)) lacc]
           ;if the character at pos is not alphabetic, find the next alpha
           ;char using a helper function from Problem 6.
           [(not (char-alphabetic? (string-ref str pos)))
            ;; find the substring in str that starts at the next char
            (helper (substring str (find-next-alph (substring str pos) pos)) 
                    0 lacc)]
           ;if the character at pos is alphabetic, gather the next sequence of
           ;alphabetic characters and append the string to the accumulator.
           ;This clause uses a helper function from Problem 8 to find the next
           ;non-alphabetic char and the helper function find-next-nonc to 
           ;accumulate a string to append to the output list in lacc.
           [else
            (helper (substring str (find-next-nc (substring str pos) pos)) 0  
                    (append 
                     lacc 
                     (list (find-next-nonc (substring str pos) pos ""))))]))]  
      ;calls helper
      (helper str 0 empty))))

; 
;  Problem 8:
;  
;  Define a function copy-n that consumes a list of anything and a     
;  number, N,  and produces the contents of the input list appended 
;  to itself N times.
;  
;  Examples to help clarify the problem:
;  
;  > (copy-n (list 1 2 3) 4)   ==> (list 1 2 3 1 2 3 1 2 3 1 2 3)
;  
;  > (copy-n (list 1 2 3) 0)   ==> empty
;  
;  > (copy-n empty 4)   ==> empty
;  


; Contract: (copy-n list-of-anything number) -> list-of-anything
; Header:   (define copy-n (lambda (loa n) ... ))
; Purpose:  return list with n copies of loa 

; Pre-function tests:
(check-expect (copy-n (list 1 2 3) 4) (list 1 2 3 1 2 3 1 2 3 1 2 3))
(check-expect (copy-n (list 1 2 3) 0) empty)
(check-expect (copy-n empty 4) empty)

;; Function definition:
(define copy-n
  (lambda (loa n)
    (cond
      ;; base case 1: if loa is empty, return empty list
      ;; NOTE: recursion is over n, not the loa, so this clause
      ;;       can only occur if loa is initially empty
      [(empty? loa) empty]
      ;; base case 2: if n is 0, return empty list
      [(= n 0) empty]     
      [else
       (append loa (copy-n loa (sub1 n)))])))

; 
;  Problem 9: 
;  
;  Use build-list
;  
;  1. To create the lists (list 0 ... 3) and (list 1 ... 4).
;  
;  2. To define a function evens, which consumes a natural 
;     number n and creates the list of the first n even numbers.      
; 
;  Hint: Use un-named lambda style functions in your calls to 
;  build-list.
;     


; 1. To create the lists (list 0 ... 3) and (list 1 ... 4):
(build-list 4 (lambda (x) x))
(build-list 4 add1)

; Contract: (evens positive-integer) -> list-of-integers
; Header:   (define evens (lambda (loi) ... ))
; Purpose:  Create a list containing the first n positive even integers

; Pre-function tests:
(check-expect (evens 8) (list 2 4 6 8 10 12 14 16))
(check-expect (evens 2) (list 2 4))
(check-expect (evens 3) (list 2 4 6))

; Function definition:
(define evens
  (lambda (n)
    ;; Note: unnamed lambda used in build-list
    (build-list n (lambda (x) (* (add1 x) 2)))));; 

; 
;  Problem 10: 
;  
;  Use map to create the function move-all, which consumes a list     
;  of posn structures and translates each by adding 3 to the x-
;  field. 
;  


; Contract: (move-all list-of-posns) -> list-of-posns
; Header:   (define move-all (lambda (lop) ... ))
; Purpose:  To translate each posn by adding 3 to the x field

; Pre-function tests:
(check-expect (move-all (list (make-posn 1 4) (make-posn 2 6)))
              (list (make-posn 4 4) (make-posn 5 6)))
(check-expect (move-all empty) empty)

; Function definition:
(define move-all
  (lambda (lop)
    ;; Use unnamed lambda that creates a new posn for every posn in lop
    (map (lambda (p) (make-posn (+ (posn-x p) 3) (posn-y p))) lop))) 

; 
;  Problem 11: 
;  
;  Use filter to create the function selection, which consumes 2      
;  lists of quoted symbols and produces all the elements from the
;  second list that are also on the first.
; 
;  


; Contract: (selection list-of-symbols list-of-symbols) -> list-of-symbols
; Header:   (define selection (lambda (ls1 ls2) ... ))
; Purpose:  To produce a list of symbols representing the intersection of 
;           ls1 and ls2

; Pre-function tests:
(check-expect (selection '(a b c d e) '(a c e)) '(a c e))
(check-expect (selection '(a a a a a) '(b a)) '(a))
(check-expect (selection '(a a a a a) '(b a a a)) '(a a a))
(check-expect (selection empty '(b a)) empty)
(check-expect (selection '(a a a a a) empty) '())
(check-expect (selection '(a a a a a) '(b b b b b)) '())

; Function definition:
(define selection
  (lambda (ls1 ls2)
    ;; check whether each element of ls2 is a member of ls1 and return
    ;; list of symbols that are in both
    (filter (lambda (s) (member? s ls1)) ls2))) 

; 
;  Problem 12: 
;  
;  Suppose you wanted to write a big-bang simulation that places an    
;  image of a solid maroon circle of radius 20 at the point where 
;  the mouse is clicked on the scene (i.e., a "button-down" event). 
;  At any point in time, there will be at most one circle displayed.
;  
;  (a) What constants would you need to define?
;  
;      width and height of empty scene, empty scene, radius, color, mode, 
;      event-type, initial-world, circle,
;      
;  
;  (b) What values or structure would you use to define the state of 
;      the world and why?
;      
;      A single posn or two numbers.
;  
;  (c) Which clauses (on-draw, on-tick, on-key, on-mouse) would you 
;      need to include in the call to big bang?
;      
;      on-draw: to show circle on scene
;      on-mouse: to detect mouse events
;  
;  (d) Write the function used as input to each of the clauses you
;      mentioned in part (c).  Write the invocation of big-bang. 
;  


;; Constants:
(define WIDTH 400)
(define HEIGHT 400)
(define MT (empty-scene WIDTH HEIGHT))
(define RADIUS 20)
(define COLOR "maroon") ;; Go Aggies!
(define MODE "solid")
(define MOUSE-EVENT "button-down")
(define CIRCLE (circle RADIUS MODE COLOR))
(define INITIAL-WORLD (make-posn -50 -50)) ;; create initial circle off-scene

; Contract: (show-scene posn) -> image
; Header:   (define show-scene (lambda (w) ... ))
; Purpose:  display the scene initially and after every change in the
;           world state w

; Function definition:
(define show-scene
  (lambda (w)
    (place-image
     CIRCLE
     (posn-x w)
     (posn-y w)
     MT)))

; Contract: (click-result posn number number string) -> posn
; Header:   (define click-result (lambda (w x y str) ... ))
; Purpose:  make a new world state when the mouse button is clicked on
;           the scene the world state w

; Function definition:
(define click-result
  (lambda (w x y str)
    (if (string=? str MOUSE-EVENT)
        ;; if str is "button-down" event, make new posn at x,y
        (make-posn x y)
        ;; otherwise, return world unchanged
        w)))

; Contract: (main posn) -> posn
; Header:   (define main  (lambda (w) ... ))
; Purpose:  Call big-bang on intial world w

; Function definition:
(define main
  (lambda (w)
    (big-bang w
              (on-draw show-scene)
              (on-mouse click-result))))

;; initial call starting big-bang
;(main INITIAL-WORLD)

; 
;  Problem 13: 
;  
;  Evaluate the result of the following expressions:                   
;  
;  (a)  (filter cons? '(1 (2 3) 4 9 (8 7) ((2))))
;  
;       (list (list 2 3) (list 8 7) (list (list 2)))
;  
;  (b)  (map expt '(1 3 4) '(2 2 2))
;  
;       (list 1 9 16)
;  
;  (c)  (apply + (map expt '(1 3 4) '(2 2 2)))
;  
;       26
;