;;; File:
;;;   student.scm
;;; Author:
;;;   Samuel A. Rebelsky
;;; Summary:
;;;   A collection of procedures for maintaining a simple
;;;   representation about students in a class.
;;; History:
;;;   At end.

; +-------------------------------------------------------------------
; | Design Decisions |
; +------------------+

; We represent each student as a ten-element vector.
; * 0: a string for the student's last name;
; * 1: a string for the student's first name;
; * 2: a string for student's student id number;
; * 3: a string for the student's major;
; * 4: an integer for the students' graduation year;
; * 5: a list of symbols (<code>'check</code>, <code>'minus</code>,
;   <code>'check-plus</code>, etc.) for homework grades;
; * 6: a list of real numbers for exam grades;
; * 7: a list of strings (<code>"A"</code>, <code>"B-"</code>, etc.)
;   for project grades;
; * 8: a single real number for participation grade; and
; * 9: a list of strings for extra credit events.

; +------+------------------------------------------------------------
; | HOPs |
; +------+

(define left-section
  (lambda (proc left)
    (lambda (right)
      (proc left right))))
(define l-s left-section)

(define right-section
  (lambda (proc right)
    (lambda (left)
      (proc left right))))
(define r-s right-section)


; +-------------------------------------------------------------------
; | Constructors |
; +--------------+

;;; Procedure:
;;;   make-student
;;; Parameters:
;;;   last-name, a string
;;;   first-name, a string
;;;   id, a string
;;;   major, a string
;;;   graduation-year, an integer
;;; Purpose:
;;;   Create a new student record.
;;; Produces:
;;;   student, a student record.
;;; Preconditions:
;;;   (None)
;;; Postconditions:
;;;   student is a valid student.
(define make-student
  (lambda (last-name first-name id major graduation-year)
    (cond
      ((not (string? last-name))
       (error "make-student: parameter 0 (last-name) must be a string"))
      ((not (string? first-name))
       (error "make-student: parameter 1 (first-name) must be a string"))
      ((not (string? id))
       (error "make-student: parameter 3 (id) must be a string"))
      ((not (string? major))
       (error "make-student: parameter 4 (major) must be a string"))
      ((not (integer? graduation-year))
       (error "make-student: parameter 5 (graduation-year) must be an integer"))
      ((not (valid-graduation-year? graduation-year))
       (error "make-student: parameter 6 (graduation-year) is invalid"))
      (else
       (vector last-name first-name id major graduation-year
               null null null 90 null)))))


; +-----------+-------------------------------------------------------
; | Selectors |
; +-----------+

;;; Procedures;
;;;   get-student-last-name
;;;   get-student-first-name
;;;   get-student-id
;;;   get-student-major
;;;   get-student-graduation-year
;;;   get-student-homework
;;;   get-student-exams
;;;   get-student-projects
;;;   get-student-participation
;;;   get-student-ec
;;; Parameters:
;;;   student, a student
;;; Purpose:
;;;   Get one attribute of a student.
;;; Produces:
;;;   val, the appropriate value.
(define get-student-last-name (r-s vector-ref 0))
(define get-student-first-name (r-s vector-ref 1))
(define get-student-id (r-s vector-ref 2))
(define get-student-major (r-s vector-ref 3))
(define get-student-graduation-year (r-s vector-ref 4))
(define get-student-homework (r-s vector-ref 5))
(define get-student-exams (r-s vector-ref 6))
(define get-student-projects (r-s vector-ref 7))
(define get-student-participation (r-s vector-ref 8))
(define get-student-ec (r-s vector-ref 9))


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

;;; Procedure:
;;;   count-student-ec
;;; Parameters:
;;;   student, a student
;;; Purpose:
;;;   Count the student's extra credit.
;;; Produces:
;;;   ecval, a real number
(define count-student-ec
  (lambda (student)
    (length (get-student-ec student))))

(define symgrade->number
  (lambda (sym)
    (cond
      ((eq? sym 'plus) 120)
      ((eq? sym 'check-plus) 95)
      ((eq? sym 'check) 85)
      ((eq? sym 'check-minus) 80)
      ((eq? sym 'minus) 75)
      (else 0))))

(define letgrade->number
  (lambda (letter)
    (cond
      ((equal? letter "A+") 100)
      ((equal? letter "A") 96)
      ((equal? letter "A-") 91)
      ((equal? letter "B+") 88)
      ((equal? letter "B") 85)
      ((equal? letter "B-") 81)
      ((equal? letter "C+") 78)
      ((equal? letter "C") 75)
      ((equal? letter "D") 65)
      ((equal? letter "F") 50)
      (else 0))))

(define evaluate-student-homework
  (lambda (student)
    (let ((homework (get-student-homework student)))
      (cond
        ((null? homework) 0)
        ((null? (cdr homework)) (symgrade->number (car homework)))
        (else
         (average (remove-smallest (map symgrade->number homework))))))))

(define evaluate-student-projects
  (lambda (student)
    (let ((projects (get-student-projects student)))
      (if (null? projects) 0
          (average (map letgrade->number projects))))))

(define evaluate-student-exams
  (lambda (student)
    (let ((exams (get-student-exams student)))
      (cond
        ((null? exams) 0)
        ((null? (cdr exams)) (car exams))
        (else
         (average (remove-smallest exams)))))))

(define grade
  (lambda (student)
    (+ (* .10 (get-student-participation student))
       (* .25 (evaluate-student-homework student))
       (* .45 (evaluate-student-exams student))
       (* .20 (evaluate-student-projects student))
       (* .5 (count-student-ec student)))))

; +----------+-------------------------------------------------------
; | Mutators |
; +----------+

;;; Procedures;
;;;   set-student-last-name!
;;;   set-student-first-name!
;;;   set-student-major!
;;;   set-student-graduation-year!
;;;   set-student-participation!
;;; Parameters:
;;;   student, a student
;;;   val, the value to set the specified field to.
;;; Purpose:
;;;   Get one attribute of a student.
;;; Produces:
;;;   val, the appropriate value.
(define set-student-last-name!
  (lambda (student val)
    (if (not (string? val))
        (error "set-student-last-name: parameter must be a string.")
        (vector-set student 0 val))))

(define set-student-first-name! 
  (lambda (student val)
    (if (not (string? val))
        (error "set-student-first-name!: parameter must be a string.")
        (vector-set student 1 val))))

(define set-student-major!
  (lambda (student val)
    (if (not (string? val))
        (error "set-student-major!: parameter must be a string.")
        (vector-set student 2 val))))

(define set-student-graduation-year!
  (lambda (student val)
    (cond 
      ((not (integer? val))
       (error "set-student-graduation-year!: parameter must be an integer."))
      ((not (valid-graduation-year? val))
       (error "set-student-graduation-year!: invalid graduation year."))
      (else
       (vector-set student 4 val)))))

(define set-student-participation!
  (lambda (student val)
    (if (not (integer? val))
        (error "set-student-participation!: parameter must be an integer.")
        (vector-set student 8 val))))

;;; Procedure:
;;;   add-student-homework!
;;; Parameters:
;;;   student, a student
;;;   grade, a symbol ('plus, 'check-plus, 'check, 'check-minus, 'minus,
;;;    or 'zero)
;;; Purpose:
;;;   Add a homework assignment.
;;; Produces:
;;;   Nothing; called for the side effect.
(define add-student-homework!
  (let ((valid-grades (list 'plus 'check-plus 'check 'check-minus
                            'minus 'zero)))
    (lambda (student grade)
      (cond
        ((not (symbol? grade))
         (error "add-student-homework!: expects a symbol"))
        ((not (member grade valid-grades))
         (error "add-student-homework!: invalid grade"))
        (else
         (vector-set! student 5
                      (append (vector-ref student 5)
                              (list grade))))))))
           
;;; Procedure:
;;;   add-student-exam!
;;; Parameters:
;;;   student, a student
;;;   exam, a real number.
;;; Purpose:
;;;   Add an exam grade.
;;; Produces:
;;;   Nothing; called for the side effect.
(define add-student-exam!
  (lambda (student exam)
    (if (not (real? exam))
        (error "add-student-exam!: expects a real number"))
        (vector-set! student 6
                     (append (vector-ref student 6)
                             (list exam)))))
           
;;; Procedure:
;;;   add-student-project!
;;; Parameters:
;;;   student, a student
;;;   grade, a string ("A+", "A", "A-", "B+", "B", "B-", "C+", "C", "D"
;;;    "F", "0")
;;; Purpose:
;;;   Add a project grade.
;;; Produces:
;;;   Nothing; called for the side effect.
(define add-student-project!
  (let ((valid-grades (list "A+" "A" "A-" "B+" "B" "B-" "C+" "C" 
                            "D" "F" "0")))
    (lambda (student grade)
      (cond
        ((not (string? grade))
         (error "add-student-project!: expects a string"))
        ((not (member grade valid-grades))
         (error "add-student-project!: invalid grade"))
        (else
         (vector-set! student 7
                      (append (vector-ref student 7)
                              (list grade))))))))

;;; Procedure:
;;;   add-student-ec!
;;; Parameters:
;;;   student, a student
;;;   event, a string
;;; Purpose:
;;;   Gives extra credit to the student.
;;; Produces:
;;;   Nothing; called for the side effect.
(define add-student-ec!
  (lambda (student event)
    (if (not (string? event))
        (error "add-student-ec: parameter must be a string")
        (vector-set! student 9
                    (append (vector-ref student 9)
                            (list event))))))

           
; +-------------------------------------------------------------------
; | Misc. |
; +-------+

;;; Procedure:
;;;   display-line
;;; Parameters:
;;;   val0, val2, ... valn: 0 or more values.
;;; Purpose:
;;;   Displays all of the values, followed by a carriage return.
(define display-line
  (letrec ((kernel 
            (lambda (remaining)
              (if (null? remaining)
                  (newline)
                  (begin
                    (display (car remaining))
                    (kernel (cdr remaining)))))))
    (lambda vals
      (kernel vals))))

;;; Procedure:
;;;   display-category
;;; Parameters:
;;;   category, a string
;;;   lst, a list
;;; Purpose:
;;;   Display all the values for a particular category.
(define display-category
  (lambda (cat lst)
    (letrec ((kernel 
              (lambda (lst)
                (if (null? (cdr lst))
                    (begin 
                      (display (car lst))
                      (newline))
                    (begin 
                      (display (car lst))
                      (display ", ")
                      (kernel (cdr lst)))))))
      (if (null? lst)
          (display-line "No " cat ".")
          (begin
            (display cat)
            (display ": ")
            (kernel lst))))))

;;; Procedure:
;;;   display-student
;;; Parameters:
;;;   student, a student
;;; Purpose:
;;;   Print out information on the student.
;;; Produces:
;;;   Nothing; called for the side effect.
(define display-student
  (lambda (student)
    (display-line "Record for " (get-student-last-name student)
                  ", " (get-student-first-name student)
                  " [ID: " (get-student-id student) "]")
    (display-line "Major: " (get-student-major student)
                  "; Class: " (get-student-graduation-year student))
    (display-category "Homework" (get-student-homework student))
    (display-category "Exams" (get-student-exams student))
    (display-category "Projects" (get-student-projects student))
    (display-line "Participation: " (get-student-participation student))
    (display-category "Extra Credit" (get-student-ec student))))

;;; Procedure:
;;;   valid-graduation-year?
;;; Parameters:
;;;   graduation-year, an integer [unverified]
;;; Purpose:
;;;   Determines whether graduation-year is valid.
;;; Produces:
;;;   is-valid?, a boolean
(define valid-graduation-year?
  (lambda (graduation-year)
    (<= 2000 graduation-year 2010)))

;;; Purpose:
;;;   remove-smallest
;;; Parameters:
;;;   nums, a list of real numbers
;;; Purpose:
;;;   Removes the smallest value in nums.
;;; Produces:
;;;   newnums, a list of real numbers.
;;; Preconditions:
;;;   nums is nonempty.
;;; Postconditions:
;;;   newnums is a permutation of (cons (smallest nums) nums)
(define remove-smallest
  (lambda (nums)
    (let kernel ((remaining (cdr nums))
                 (smallest-so-far (car nums)))
      (cond
        ((null? remaining)
         null)
        ((< (car remaining) smallest-so-far)
         (cons smallest-so-far 
               (kernel (cdr remaining) (car remaining))))
        (else 
         (cons (car remaining)
               (kernel (cdr remaining) smallest-so-far)))))))

(define average
  (lambda (nums)
    (/ (apply + nums) (length nums))))


; +-------------------------------------------------------------------
; | History |
; +---------+

; Monday, 20 November 2006 [Samuel A. Rebelsky]
; * Created.