#lang racket
(require gigls/unsafe)
(require rackunit)
(require rackunit/text-ui)
; (require CSC151-2015S/a-sock)

;;; File:
;;;   exam4.rkt
;;; Authors:
;;;   The student currently referred to as 000000
;;;   Samuel A. Rebelsky
;;; Contents:
;;;   Code and solutions for Exam 4 2015S
;;; Citations:
;;;

; +---------+--------------------------------------------------------
; | Grading |
; +---------+

; This section is for Sam's use.

; Problem 1: 
; Problem 2:
; Problem 3:
; Problem 4:
; Problem 5:
; Problem 6:
; Problem 7:
;           ----
;     Total:

;    Scaled:
;    Errors:
;     Times:
;          :
;          :
;          :
;           ----
;     Total:

; +-----------+------------------------------------------------------
; | Problem 1 |
; +-----------+

; Time Spent: 

; Citations:

; Solution:

(define assoc-tests
  (test-suite 
   "Tests of Assoc"
   (test-case 
    "Numeric examples from the exam (provided)"
    (let ([table (list (cons 1 2) (cons 3 4) (cons 5 6) (cons 7 8))])
      (check-equal? (assoc 1 table) (cons 1 2) "Look for 1")
      (check-equal? (assoc 5 table) (cons 5 6) "Look for 5")))))

; Examples:

; > (run-tests assoc-tests)

; +-----------+------------------------------------------------------
; | Problem 2 |
; +-----------+

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   table->lookup
;;; Parameters:
;;;   table, a list of pairs
;;; Purpose:
;;;   Create a lookup function for the table
;;; Produces:
;;;   lookup, a unary function
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   If there is an entry of table whose car is key, (lookup key) is 
;;;     the cdr of the first such entry.
;;;   If there is no such entry, (lookup key) issues an error of the 
;;;     form "Could not find ..."
(define table->lookup
  (lambda (table)
    0))

; Examples:


; +-----------+------------------------------------------------------
; | Problem 3 |
; +-----------+

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   iterate
;;; Parameters:
;;;   proc!, a unary procedure
;;;   initial, an integer
;;;   final, an integer
;;;   offset, an integer
;;; Purpose:
;;;   Repeatedly call proc! on the sequence of values initial,
;;;   initial+offset, initial+2*offset, initial+3*offset, and
;;;   so on and so forth.
;;; Produces:
;;;   [Nothing; called for the side effect]
;;; Preconditions:
;;;   [No additional
;;; Postconditions:
;;;   The following operations have been executed, in this order.
;;;     (proc! initial)
;;;     (proc! (+ initial offset))
;;;     (proc! (+ initial (* 2 offset))
;;;     ...
;;;     (proc! (+ initial (* n offset))
;;;   (<= (+ initial (* n offset)) final)
;;;   (> (+ initial (* (+ 1 n) offset)) final)
(define iterate
  (lambda (proc! initial final offset)
    (void)))

; Examples:


; +-----------+------------------------------------------------------
; | Problem 4 |
; +-----------+

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   tree?
;;; Parameters:
;;; 
;;; Purpose:
;;; 
;;; Produces:
;;;
;;; Preconditions:
;;; 
;;; Postconditions:
;;;
(define tree?
  (lambda (val)
    #t))

; Examples:


; +-----------+------------------------------------------------------
; | Problem 5 |
; +-----------+

; Time Spent: 

; Citations:

; Solution:
(define vector->tree
  (lambda (vec)
    nil))

; Examples:


; +-----------+------------------------------------------------------
; | Problem 6 |
; +-----------+

; Time Spent: 

; Citations:

; Solution:
(define bst-find
  (lambda (key tree)
    (error "Could not find" key)))

; Examples:


; +-----------+------------------------------------------------------
; | Problem 7 |
; +-----------+

; Time Spent: 

; Citations:

; a. Updated code for analysis:

;;; Procedure:
;;;   tree-flatten
;;; Parameters:
;;;   tree, a tree
;;; Purpose:
;;;   "Flatten" the tree into the corresponding list.
;;; Produces:
;;;   lst, a list
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   Every value in the tree appears in the list.
;;;   No additional values appear in the list.
;;;   The values are in the same order in the list as they are
;;;     in the tree.  (Things in the left subtree appear before
;;;     the value in a node, which appears before things in the
;;;     right subtree.
(define tree-flatten
  (lambda (tree)
    (if (nil? tree)
        null
        (list-append (tree-flatten (left-subtree tree))
                     (cons (root-value tree)
                           (tree-flatten (right-subtree tree)))))))
;;; Procedure:
;;;   list-append
;;; Parameters:
;;;   front, a list of size n
;;;   back, a list of size m
;;; Purpose:
;;;   Put front and back together into a single list.
;;; Produces:
;;;   appended, a list of size n+m.
;;; Preconditions:
;;;   front is a list [Unverified]
;;;   back is a list [Unverified]
;;; Postconditions:
;;;   For all i, 0 <= i < n,
;;;    (list-ref appended i) is (list-ref front i)
;;;   For all i, <= i < n+m
;;;;   (list-ref appended i) is (list-ref back (- i n))
(define list-append
  (lambda (front back)
    (if (null? front)
        back
        (cons (car front) (list-append (cdr front) back)))))

; b. Number of calls to cons

; t1: 
; t2: 
; t3: 
; t4: 
; t5: 
; t6: 
; t7: 

; c. Which requires the most calls?  Why?

; d. Which requires the fewest calls?  Why?

; e. Revised version
(define tree-flatten-new
  (lambda (tree)
    (let kernel ([tree tree]
                 [flattened null])
      nil)))

; Examples:


; ===================================================================

; PLEASE MAKE A COPY OF YOUR CODE AND THEN REMOVE EVERYTHING BELOW 
; THIS POINT BEFORE PRINTING.

; PLEASE DO NOT ADD ANYTHING BELOW THIS POINT.

; +---------------------------+--------------------------------------
; | Tree Utilities (Provided) |
; +---------------------------+

;;; Name:
;;;   nil
;;; Type:
;;;   tree
;;; Value:
;;;   The empty tree
(define nil 'nil)

;;; Procedure:
;;;   nil?
;;; Parameters:
;;;   val, a Scheme value
;;; Purpose:
;;;   Determine if val represents an empty tree.
;;; Produces:
;;;   is-nil?, a Boolean 
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   is-nil? is true (#t) if and only if val can be interpreted as
;;;   the empty tree.
(define nil? 
  (l-s eq? nil))

;;; Procedure:
;;;   node
;;; Parameters:
;;;   val, a value
;;;   left, a tree
;;;   right, a tree
;;; Purpose:
;;;   Create a node in a binary tree.
;;; Produces:
;;;   tree, a tree
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   (node? tree) holds.
;;;   (left-subtree tree) = left.
;;;   (right-subtree tree) = right.
;;;   (root-value tree) = val.
(define node
  (lambda (val left right)
    (vector 'node val left right)))

;;; Procedure:
;;;   node?
;;; Parameters:
;;;   val, a Scheme value
;;; Purpose:
;;;   Determine if val can be used as a tree node.
;;; Produces:
;;;   is-tree?, a Boolean
(define node?
  (lambda (val)
    (and (vector? val)
         (= (vector-length val) 4)
         (eq? (vector-ref val 0) 'node))))

;;; Procedure:
;;;   leaf?
;;; Parameters:
;;;   nod, a binary tree node
;;; Purpose:
;;;   Determine if node is a leaf
;;; Produces:
;;;   is-leaf?, a Boolean
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   is-leaf? is true iff the left subtree and the right subtree are nil.
(define leaf?
  (lambda (nod)
    (and (nil? (left-subtree nod))
         (nil? (right-subtree nod)))))

;;; Procedure:
;;;   left-subtree
;;; Parameters:
;;;   nod, a binary tree node
;;; Purpose:
;;;   Extract the left subtree of nod.
;;; Produces:
;;;   val, a Scheme value
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   (left-subtree (node val left right)) = left
(define left-subtree
  (r-s vector-ref 2))

;;; Procedure:
;;;   right-subtree
;;; Parameters:
;;;   nod, a binary tree node
;;; Purpose:
;;;   Extract the right subtree of nod.
;;; Produces:
;;;   val, a Scheme value
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   (right-subtree (node val left right)) = right
(define right-subtree
  (r-s vector-ref 3))

;;; Procedure:
;;;   root-value
;;; Parameters:
;;;   nod, a binary tree node
;;; Purpose:
;;;   Extract the value of nod.
;;; Produces:
;;;   val, a Scheme value
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   (root-value (node val left right)) = val
(define root-value
  (r-s vector-ref 1))

;;; Procedure:
;;;   tree-depth
;;; Parameters:
;;;   tree, a tree
;;; Purpose:
;;;   Determine the depth of tree
;;; Produces:
;;;   depth, an integer
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   depth represents the number of nodes on the path from the root to 
;;;   the furthest leaf.
(define tree-depth
  (lambda (tree)
    (if (nil? tree)
        0
        (+ 1 (max (tree-depth (left-subtree tree))
                  (tree-depth (right-subtree tree)))))))

;;; Procedure:
;;;   tree->code
;;; Parameters:
;;;   tree, a tree
;;; Purpose:
;;;   Generate Scheme code to make a tree.
;;; Produces:
;;;   code, a Scheme value
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   code, when evaluated, can give something like tree
(define tree->code
  (lambda (tree)
    (if (nil? tree)
        'nil
        (list 'node 
              (root-value tree) 
              (tree->code (left-subtree tree))
              (tree->code (right-subtree tree))))))

;;; Procedure:
;;;   visualize-tree
;;; Parameters:
;;;   tree, a binary tree
;;;   width, a positive integer
;;;   height, a positive integer
;;; Purpose:
;;;   Create a simple image to visualize a tree
;;; Produces:
;;;   image, an image
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   image contains an "appropriate" representation of the tree.
;;;   The context may have been updated.
;;; Problems:
;;;   Doesn't do well with especially bushy trees - these may overlap.
(define visualize-tree
  ; Draw the nil tree
  (let ([draw-nil!
         (lambda (image x y)
           (context-set-fgcolor! "grey")
           (image-select-ellipse! image REPLACE (- x 5) (- y 10) 10 10)
           (image-draw-line! image (- x 5) (- y 10) (+ x 5) y)
           (image-stroke! image)
           (image-select-nothing! image))])
    (lambda (tree width height)
      ; Set the font
      (context-set-font-name! "Monospace")
      (context-set-font-size! 12)
      ; Set the brush
      (context-set-brush! "2. Hardness 100" 1)
      (let (; The resulting image
            [result (image-show (image-new width height))]
            ; The height of each level
            [level-height (/ (- height 20) (tree-depth tree))])
        (letrec (; Primary work: Procedure to do a subtree
                 [visualize-subtree 
                  (lambda (subtree left top subwidth)
                    (let ([center-x (+ left (/ subwidth 2))]
                          [center-y (+ top 15)])
                      (cond
                        [(nil? subtree)
                         (draw-nil! result center-x center-y)]
                        [else
                         ; Display the node's value
                         (context-set-fgcolor! "black")
                         (image-display-text! result
                                              (value->string (root-value subtree))
                                              center-x center-y
                                              ALIGN-CENTER ALIGN-BOTTOM)
                         (let ([left-child (left-subtree subtree)]
                               [right-child (right-subtree subtree)]
                               [half-width (/ subwidth 2)]
                               [quarter-width (/ subwidth 4)]
                               [next-top (+ top level-height)])
                           ; Display the links
                           (context-set-fgcolor! "grey")
                           (image-draw-arrow! result
                                              'filled
                                              center-x center-y
                                              (- center-x quarter-width) next-top
                                              5 5)
                           (image-draw-arrow! result
                                              'filled
                                              center-x center-y
                                              (+ center-x quarter-width) next-top
                                              5 5)
                           ; Left subtree
                           (visualize-subtree left-child left next-top half-width)
                           ; Right subtree
                           (visualize-subtree right-child center-x next-top half-width))])))])
          ; Do the whole tree
          (visualize-subtree tree 0 0 width))))))

; +------------------------------+-----------------------------------
; | Analyis Utilities (Provided) |
; +------------------------------+

; Citation: These procedures were found in the reading and lab on Procedure
; Analysis, found at
;   <http://www.cs.grinnell.edu/~rebelsky/Courses/CSC151/2015S/readings/analysis-reading.html>
; and
;   <http://www.cs.grinnell.edu/~rebelsky/Courses/CSC151/2015S/labs/analysis-lab.html>
; and
;   <http://www.cs.grinnell.edu/~rebelsky/Courses/CSC151/2015S/code/analysis-lab.rkt>.

;;; Procedure:
;;;   counter-new
;;; Parameters:
;;;   name, a string
;;; Purpose:
;;;   Create a counter associated with the given name.
;;; Produces:
;;;   counter, a counter
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   counter can be used as a parameter to the various counter
;;;   procedures.
;;; Process:
;;;   Counters are two element vectors.  Element 0 is the name, and
;;;   should not change.  Element 1 is the count, and should change.
(define counter-new
  (lambda (name)
    (vector name 0)))

;;; Procedure:
;;;   counter-count!
;;; Parameters:
;;;   counter, a counter 
;;; Purpose:
;;;   count the counter
;;; Produces:
;;;   counter, the same counter, now mutated
;;; Preconditions:
;;;   counter was created by counter-new (or something similar) and
;;;   has only been modified by the counter procedures.
;;; Postconditions:
;;;   (counter-get counter) gives a number one higher than it 
;;;   did before.
(define counter-count!
  (lambda (counter)
    (vector-set! counter 1 (+ 1 (vector-ref counter 1)))
    counter))

;;; Procedure:
;;;   counter-get
;;; Parameters:
;;;   counter, a counter
;;; Purpose:
;;;   Get the number of times that counter-count! has been called
;;;   on this counter.
;;; Produces:
;;;   count, a non-negative integer
;;; Preconditions:
;;;   counter was created by counter-new and has only been modified
;;;   by the counter procedures.
;;; Postconditions:
;;;   count is the number of calls to counter-new on this counter since
;;;   the last call to counter-reset! on this counter, or since the
;;;   counter was created, if there have been no calls to counter-reset!
(define counter-get
  (lambda (counter)
    (vector-ref counter 1)))

;;; Procedure:
;;;   counter-reset!
;;; Parameters:
;;;   counter, a counter 
;;; Purpose:
;;;   reset the counter
;;; Produces:
;;;   counter, the same counter, now set to 0
;;; Preconditions:
;;;   counter was created by counter-new (or something similar) and
;;;   has only been modified by the other counter procedures.
;;; Postconditions:
;;;   (counter-get counter) gives 0.
(define counter-reset!
  (lambda (counter)
    (vector-set! counter 1 0)
    counter))

;;; Procedure:
;;;   counter-print!
;;; Parameters:
;;;   counter, a counter
;;; Purpose:
;;;   Print out the information associated with the counter.
;;; Produces:
;;;   counter, the same counter
;;; Preconditions:
;;;   counter was created by counter-new and has only been modified
;;;   by the various counter procedures.
;;; Postconditions:
;;;   counter is unchanged.
;;;   The output port now contains information on counter.
;;; Ponderings:
;;;   Why does counter-print! have a bang, given that it doesn't mutate
;;;   it's parameter?  Because it mutates the broader environment - we
;;;   call counter-print! not to compute a value, but to print something.
(define counter-print!
  (lambda (counter)
    (display (vector-ref counter 0))
    (display ": ")
    (display (vector-ref counter 1))
    (newline)))

;;; Name
;;;   cons-counter
;;; Type:
;;;   counter
;;; Value:
;;;   A counter for calls to cons.  
(define cons-counter (counter-new "cons"))

;;; Procedure:
;;;   $cons
;;; Parameters:
;;;   val, a Scheme value
;;;   lst, a list (or other Scheme value)
;;; Purpose:
;;;   Create a new list by prepending val while recording the
;;;   operation for future analysis.
;;; Produces:
;;;   newlst, a list
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   (car newlst) = val
;;;   (cdr newlst) = lst
;;;   cons-counter has been increemented by 1
(define $cons
  (lambda (val lst)
    (counter-count! cons-counter)
    (cons val lst)))

; +--------------------------------+---------------------------------
; | Binary Search Trees (Provided) |
; +--------------------------------+

; A binary search tree of some Grinnell courses arranged by ID.
(define some-grinnell-courses
  (node
   (cons "MAT209" "Applied Statistics")
   (node
    (cons "ECN226" "Economics of Innovation")
    (node
     (cons "CLS255" "History of Ancient Greece")
     (node
      (cons "ART240" "Ceramics")
      (node
       (cons "AMS130" "Intro to American Studies")
       nil
       (node (cons "ART134" "Drawing") nil nil))
      (node
       (cons "BIO305" "Evolution of the Iowa Flora")
       nil
       (node (cons "CHM331" "Chemistry is Everywhere") nil nil)))
     (node
      (cons "CSC161" "Imperative Problem Solving")
      (node
       (cons "CSC105" "The Digital Age")
       nil
       (node (cons "CSC151" "Functional Problem Solving") nil nil))
      (node
       (cons "CSC207" "Algorithms and Object-Oriented Problem Solving")
       nil
       (node (cons "CSC232" "Human-Computer Interaction") nil nil))))
    (node
     (cons "GRM343" "Cultural and Intellectual Revolution")
     (node
      (cons "ENG210" "Studies in Genre")
      (node
       (cons "ECN339" "Introduction to Mathematical Economics")
       nil
       (node (cons "EDU195" "How to Learn Physics") nil nil))
      (node
       (cons "EVN295" "Environmental History of Infectious Diseases")
       nil
       (node
        (cons "GLS251" "Children's & Young Adult Literature")
        nil
        nil)))
     (node
      (cons "HIS295" "Sex in American History")
      (node
       (cons "GWS395" "Feminist/Queer Disability Studies")
       nil
       (node (cons "HIS232" "Sex, Gender, and Family in Europe") nil nil))
      (node
       (cons "HIS295" "Global Cultural Encounter")
       nil
       (node (cons "MAT115" "Introduction to Statistics") nil nil)))))
   (node
    (cons "RUS247" "The Russian Short Story")
    (node
     (cons "NRS495" "Neuroscience Seminar")
     (node
      (cons "MAT336" "Probability & Statistics II")
      (node
       (cons "MAT310" "Statistical Modeling")
       nil
       (node (cons "MAT335" "Probability & Statistics I") nil nil))
      (node
       (cons "MUS202" "Topics in American Music: Pop Music")
       nil
       (node
        (cons "MUS202" "Topics in American Music: Sound Art")
        nil
        nil)))
     (node
      (cons "POL295" "Intro to Network Analysis")
      (node
       (cons "PHY180" "Bridges, Towers, and Skyscrapers")
       nil
       (node (cons "PHY195" "How to Learn Physics") nil nil))
      (node
       (cons "PSY232" "Human-Computer Interaction")
       nil
       (node (cons "REL211" "The Hebrew Bible") nil nil))))
    (node
     (cons "SST295" "Real Life Entrepreneurship")
     (node
      (cons "SST213" "Media and the Middle East")
      (node
       (cons "SOC265" "Sociology of Health & Illness")
       nil
       (node (cons "SPN285" "Introduction to Textual Analysis") nil nil))
      (node
       (cons "SST295" "Intro to Network Analysis")
       nil
       (node (cons "SST295" "Preparing for Off-Campus Study") nil nil)))
     (node
      (cons "SST295" "Learnign Leadership from Literature")
      (node
       (cons "SST295" "Gender, Power, and Peace")
       nil
       (node
        (cons "SST295" "Race, Cinema, and the National Imaginary")
        nil
        nil))
      (node
       (cons "THD115" "Theatrical Design & Technology")
       (node (cons "TEC154" "Evolution of Technology") nil nil)
       (node (cons "TUT100" "Tutorial") nil nil)))))))

; A binary search tree of CS faculty arranged by first name
(define cs-faculty-first
  (node
   (cons "John" "Stone")
   (node
    (cons "Henry" "Walker")
    (node (cons "Charlie" "Curtsinger") nil nil)
    (node
     (cons "Janet" "Davis")
     nil
     (node (cons "Jerod" "Weinman") nil nil)))
   (node
    (cons "Peter-Michael" "Osera")
    (node (cons "Marge" "Coahran") nil nil)
    (node
     (cons "Rhys" "Price Jones")
     nil
     (node (cons "Sam" "Rebelsky") nil nil)))))

; A binary search tree of CS faculty arranged by last name
(define cs-faculty-last
  (node
   (cons "Rebelsky" "Sam")
   (node
    (cons "Curtsinger" "Charlie")
    (node (cons "Coahran" "Marge") nil nil)
    (node
     (cons "Price Jones" "Rhys")
     (node
      (cons "Osera" "Peter-Michael")
      (node (cons "Davis" "Janet") nil nil)
      nil)
     nil))
   (node
    (cons "Walker" "Henry")
    (node (cons "Stone" "John") nil nil)
    (node (cons "Weinman" "Jerod") nil nil))))

; A binary search tree of animals arranged by first letter
(define animals
  (node
   (cons "N" "Newt")
   (node
    (cons "G" "Gorilla")
    (node
     (cons "C" "Chinchilla")
     (node (cons "A" "Aardvark") nil (node (cons "B" "Babboon") nil nil))
     (node
      (cons "E" "Emu")
      (node (cons "D" "Dingo") nil nil)
      (node (cons "F" "Flying Squirrel") nil nil)))
    (node
     (cons "J" "Jackalope")
     (node (cons "H" "Hyena") nil (node (cons "I" "Iguana") nil nil))
     (node
      (cons "L" "Lemming")
      (node (cons "K" "Kiwi") nil nil)
      (node (cons "M" "Moose") nil nil))))
   (node
    (cons "T" "Tortoise")
    (node
     (cons "P" "Polar Bear")
     (node (cons "O" "Ostrich") nil (node (cons "P" "Penguin") nil nil))
     (node
      (cons "R" "Reindeer")
      (node (cons "Q" "Quail") nil nil)
      (node (cons "S" "Squirrel") nil nil)))
    (node
     (cons "W" "Wombat")
     (node (cons "U" "Uakari") nil (node (cons "V" "Vicuna") nil nil))
     (node
      (cons "Y" "Yak")
      (node (cons "X" "Xanclomys") nil nil)
      (node (cons "Z" "Zorilla") nil nil))))))

; +------------------------------------+-----------------------------
; | Additional Sample Trees (Provided) |
; +------------------------------------+

(define t1
  (node 4 (node 3 (node 2 (node 1 nil nil) nil) nil) nil))

(define t2
  (node 3 (node 2 (node 1 nil nil) nil) (node 4 nil nil)))

(define t3
  (node 3 (node 1 nil (node 2 nil nil)) (node 4 nil nil)))

(define t4
  (node 2 (node 1 nil nil) (node 4 (node 3 nil nil) nil)))

(define t5
  (node 2 (node 1 nil nil) (node 3 nil (node 4 nil nil))))

(define t6
  (node 1 nil (node 2 nil (node 3 nil (node 4 nil nil)))))

(define t7
  (node 1 nil (node 3 (node 2 nil nil) (node 4 nil nil))))