#lang racket
(require gigls/unsafe)
(require rackunit)
(require rackunit/text-ui)

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

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

; This section is for the grader's use.

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

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


; +--------------+---------------------------------------------------
; | Counter Prep |
; +--------------+

; Documentation for counter-new appears later in the exam.
(define counter-new
  (lambda (name)
    (vector name 0)))

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

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   tree-map
;;; Parameters:
;;;   proc, 
;;;   tree, 
;;; Purpose:
;;;  
;;; Produces:
;;; 
;;; Preconditions:
;;;
;;; Postconditions:
;;;
(define tree-map
  (lambda (proc tree)
    tree)) ; STUB

; Examples/Tests:


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

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   read-file
;;; Parameters:
;;;   filename, a string
;;; Purpose:
;;;   Read the contents of the given file and return it as a string.
;;; Produces:
;;;   contents, a string
;;; Preconditions:
;;;   (file-exists? filename)
;;;   filename refers to a file that contains text
;;; Postconditions:
;;;   contents represents the contents of the file (including the
;;;     newline characters).
(define read-file
  (lambda (filename)
    "")) ; STUB

;;; Procedure:
;;;   display-file
;;; Parameters:
;;;   filename, a string
;;; Purpose:
;;;   Read the contents of the given file and display them to the screen.
;;; Produces:
;;;   [Nothing; called for the side effect]
;;; Preconditions:
;;;   (file-exists? filename)
;;;   filename refers to a file that contains text
;;; Postconditions:
;;;   The contents of the given file appear on the screen.
(define display-file
  (lambda (filename)
    (newline))) ; STUB

;;; Procedure:
;;;   next-version
;;; Parameters:
;;;   filename, a string
;;; Purpose:
;;;   Identify a "safe" alternate to filename, one that does not already
;;;     exist.
;;; Produces:
;;;   alternate, a string
;;; Preconditions:
;;;   [No additiona]
;;; Postconditions:
;;;   If filename does not exist, alternate is filename.
;;;   If filename exists and has the form BASE.SUFFIX, then
;;;     alternate has the form BASE-i.SUFFIX, where i is the smallest
;;;     positive integer for which BASE-i.SUFFIX does not exist.
;;;   If filename exists and has the form BASE (no suffix), then
;;;     alternate has the form BASE-i, where i is the smallest
;;;     positive integer for which BASE-i does not exist.
(define next-version
  (lambda (filename)
    filename)) ; STUB

;;; Procedure:
;;;   create-file
;;; Parameters:
;;;   lines, a list of strings
;;;   filename, a string
;;; Purpose:
;;;   Writes each element of lines to the file, with a newline after each
;;;   element.
;;; Produces:
;;;   result, a string
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   The filesystem now contains a new version of filename.
;;;   The name of that new file result.
;;;   The lines of the given file are the lines of lines.
(define create-file
  (lambda (lines filename)
    filename)) ; STUB

; Examples/Tests:


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

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   render-pair-structure!
;;; Parameters:
;;;   image, an image
;;;   structure, a non-null pair structure
;;;   left, an integer
;;;   top, an integer
;;; Purpose:
;;;   Renders a pair structure starting at the given location in the 
;;;     given image
;;; Produces:
;;;   [Nothing; called for the side effect]
;;; Preconditions:
;;;   image contains sufficient space for the pair structure.
;;;   0 <= left < (image-width image)
;;;   0 <= top < (image-height image)
(define render-pair-structure!
  (lambda (image structure left top)
    image)) ; STUB

; Examples/Tests:

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

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   vector-join
;;; Parameters:
;;;   vec1, 
;;;   vec2, 
;;; Purpose:
;;;   
;;; Produces:
;;;   NAME, TYPE
;;; Preconditions:
;;;
;;; Postconditions:
;;;   
(define vector-join
  (lambda (vec1 vec2)
    (vector))) ; STUB

; Examples/Tests:


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

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   nest
;;; Parameters:
;;;   n, a non-negative integer
;;;   fun, a unary function
;;; Purpose:
;;;   Build a function that calls fun n times.
;;; Produces:
;;;   nested, a unary function
;;; Preconditions:
;;;   fun must be applicable to the output of fun.  (E.g., if fun returns
;;;     an integer, fun must take an integer as input.)
;;; Postconditions:
;;;   (nested x) = (fun (fun (fun ... (fun x) ...)))
;;;      Where there are n copies of fun.
;;;   nested takes the same type of input as fun.
(define nest
  (lambda (n fun)
    fun)) ; STUB

; Examples/Tests:

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

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   next-largest
;;; Parameters:
;;;   val, a real number
;;;   vec, a vector of real numbers
;;; Purpose:
;;;   Find the smallest value in vec that is greater than val
;;; Produces:
;;;   result, a real number or #f.
;;; Preconditions:
;;;   vec is a vector of real numbers sorted from smallest to largest
;;; Postconditions:
;;;   If vec contains a number greater than val, then result is the
;;;     smallest such number.
;;;   If vec does not contain a number greater than val, then result is #f.
(define next-largest
  (lambda (val vec)
    #f)) ; STUB

; Examples/Tests:


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

; Time Spent: 

; Citations:

; Solution:

; a.i. Updated version of many-circles that will now count calls 
; to cons, car, cdr, and null? in all of the helpers.

(define many-circles
  (lambda (n)
    (map vshift-drawing
         (map *
              (make-list n 10)
              (map modulo
                   (iota n)
                   (make-list n 10)))
         (map hshift-drawing
              (map *
                   (make-list n 5)
                   (iota n))
              (map scale-drawing
                   (map increment
                        (map modulo
                             (iota n)
                             (make-list n 7)))
                   (make-list n drawing-unit-circle))))))

; Some useful counters.
(define cons-counter (counter-new "cons"))
(define car-counter (counter-new "car"))
(define cdr-counter (counter-new "cdr"))
(define null?-counter (counter-new "null?"))

; Some standard procedures.
(define my-make-list
  (lambda (len val)
    (if (zero? len)
        null
        (cons val (my-make-list (- len 1) val)))))

(define my-iota
  (lambda (n)
    (let kernel [(i 0)]
      (if (= i n)
          null
          (cons i (kernel (+ i 1)))))))

(define my-map
  (lambda (fun lst)
    (if (null? lst)
        null
        (cons (fun (car lst))
              (my-map fun (cdr lst))))))

; b.
;           cons    car     cdr     null?
;     5
;    10
;    20
;    40

; c.
;           cons    car     cdr     null?
;     n       

; d.
(define new-many-circles
  (lambda (n)
    (list drawing-unit-circle)))

; Examples/Tests:

; +--------------+---------------------------------------------------
; | Extra Credit |
; +--------------+

; Time Spent: 

; Citations:

; Solution:

;;; Procedure:
;;;   mystery
;;; Parameters:
;;; 
;;; Purpose:
;;;   
;;; Produces:
;;;   NAME, TYPE
;;; Preconditions:
;;;
;;; Postconditions:
;;;   
(define mystery (l-s l-s l-s))

; Examples/Tests:

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

; THE CODE BELOW THIS LINE WAS SUPPLIED WITH THE EXAM.  PLEASE LEAVE
; IT IN PLACE IN THE ELECTRONIC VERSION OF THE EXAM!

; +------------------+-----------------------------------------------
; | Fun with Strings |
; +------------------+

;;; Procedure:
;;;   string-index-of
;;; Parameters:
;;;   str, a string
;;;   char, a character
;;; Purpose:
;;;   Find the first index of char in str
;;; Produces:
;;;   index, an integer
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   If char appears in str, 
;;;     (string-ref str index) = char
;;;     For all i < index, (string-ref str i) is not char
;;;   If char does not appear in str,
;;;     index is (string-length str)
;;; Practica:
;;;   > (string-index-of "Hello World" #\o)
;;;   4
;;;   > (string-index-of "Hello World" #\z)
;;;   11
(define string-index-of
  (lambda (str char)
    (let ([len (string-length str)])
      (let kernel ([pos 0])
        (if (or (= pos len) (char=? char (string-ref str pos)))
            pos
            (kernel (+ pos 1)))))))

;;; Procedure:
;;;   string-last-index-of
;;; Parameters:
;;;   str, a string
;;;   char, a character
;;; Purpose:
;;;   Find the last index of char in str
;;; Produces:
;;;   index, an integer
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   If char appears in str, 
;;;     (string-ref str index) = char
;;;     For all i > index, (string-ref str i) is not char
;;;   If char does not appear in str,
;;;     index is (string-length str)
;;; Practica:
;;;   > (string-last-index-of "Hello World" #\o)
;;;   7
;;;   > (string-last-index-of "Hello World" #\z)
;;;   11
;;;   > (string-last-index-of "Hello World" #\H)
;;;   0
(define string-last-index-of
  (lambda (str char)
    (let ([len (string-length str)])
      (let kernel ([pos (- len 1)])
        (cond 
          [(< pos 0)
           len]
          [(char=? char (string-ref str pos))
           pos]
          [else
           (kernel (- pos 1))])))))

; +--------------------------------+----------------------------------
; | Generalized Counter Procedures |
; +--------------------------------+

;;; 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.

;;; 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)))

; +-------------------------+----------------------------------------
; | Drawing Pair Structures |
; +-------------------------+

;;; Procedure:
;;;   render-pair!
;;; Parameters:
;;;   image, an image
;;;   pair, a pair
;;;   left, an integer
;;;   top, an integer
;;; Purpose:
;;;   Draws a pair with the top and left as specified.
;;; Produces:
;;;   [Nothing; called for the side effect]
;;; Preconditions:
;;;   0 <= left < (image-width image)
;;    0 <= top < (image-height image)
(define render-pair!
  (let ([edge 20])
    (lambda (image pair left top)
      (context-set-brush! "2. Hardness 100" 0.25)
      (context-set-fgcolor! "black")
      (let ([middle (+ left edge)]
            [right (+ left edge edge)]
            [bottom (+ top edge)])
        ; Top edge
        (image-draw-line! image left top right top)
        ; Bottom edge
        (image-draw-line! image left bottom right bottom)
        ; Left edge
        (image-draw-line! image left top left bottom)
        ; Middle edge
        (image-draw-line! image middle top middle bottom)
        ; Right edge
        (image-draw-line! image right top right bottom)
        ; Potential null in left box
        (when (null? (car pair))
          (image-draw-line! image middle top left bottom))
        ; Potential null in top box
        (when (null? (cdr pair))
          (image-draw-line! image right top middle bottom))))))

;;; Procedure:
;;;   render-value!
;;; Parameters:
;;;   image, an image
;;;   value, a Scheme value
;;;   x, an integer
;;;   top, an integer
;;; Purpose:
;;;   Render the given value horizontally centered at x with top at top.
;;; Produces:
;;;   [Nothing; called for the side effect]
;;; Preconditions:
;;;   0 <= x < (image-width image)
;;;   0 <= top < (image-height image)
(define render-value!
  (lambda (image val x top)
    ; Set the font
    (context-set-font-name! "Monospace Bold")
    (context-set-font-size! 12)
    (image-display-text! image
                         (value->string val)
                         x top
                         ALIGN-CENTER ALIGN-TOP)))

;;; Procedure:
;;;   simple-arrow!
;;; Parameters:
;;;   image, an image
;;;   x1, a real number
;;;   y1, a real number
;;;   x2, a real number
;;;   y2, a real number
;;; Purpose:
;;;   Draw an arrow from (x1,y1) to (x2,y2)
;;; Produces:
;;;   [Nothing; called for the side effects]
(define simple-arrow!
  (lambda (image x1 y1 x2 y2)
    (image-draw-arrow! image
                       'filled
                       x1 y1 
                       x2 y2
                       5 5)))

;;; Procedure:
;;;   struct-width
;;; Parameters:
;;;   struct, a pair structure
;;; Purpose:
;;;   Compute the "width" of a pair structure (in cons cells)
;;; Produces:
;;;   width, a non-negative integer
;;; Ponderings:
;;;   Used primarily for computing the appropriate size for an
;;;   image to contain a pair structure.
(define struct-width
  (lambda (struct)
    (if (pair? struct)
        (max (+ 1 (struct-width (cdr struct)))
             (struct-width (car struct)))
        0)))

;;; Procedure:
;;;   struct-height
;;; Parameters:
;;;   struct, a pair structure
;;; Purpose:
;;;   Generate the "height" of a pair structure when using the
;;;   standard rendering.
;;; Produces:
;;;   height, a real number
(define struct-height
  (lambda (struct)
    (cond
      [(null? struct)
       0]
      [(pair? struct)
       (max (+ 1 (struct-height (car struct)))
            (struct-height (cdr struct)))]
      [else
       1/2])))

;;; Procedure:
;;;   illustrate-pair-structure
;;; Parameters:
;;;   struct, a pair structure with at least one pair
;;; Purpose:
;;;   Create an illustration of struct
;;; Produces:
;;;   imag, an image
(define illustrate-pair-structure
  (lambda (struct)
    (let* ([width (struct-width struct)]
           [height (struct-height struct)]
           [image (image-new (+ 20 (* 40 width) (* 20 (- width 1)))
                             (+ 20 (* 20 height) (* 30 (- height 1))))])
      (image-show image)
      (render-pair-structure! image struct 10 10)
      image)))