;; $Id: grading.ss,v 1.7 1994/04/30 02:18:32 leavens Exp leavens $ ;; Grading policy for Com S 227X (Spring 1993) ;; ;; The most useful procedures in this file are the following ;; fraction->grade -- converts a fraction to a letter grade ;; points2grades -- tells how many points are needed to get each grade ;; make-grade-estimates -- TAs can use this to prepare reports ;; interactive-grade-estimate -- prompts for info, estimates your grade ;; ;; To run the interactive-grade-estimate program, load this file into Scheme ;; and execute ;; (interactive-grade-estimate) ;; ;; BUGS: little error checking is done ;; ;; AUTHOR: Gary T. Leavens (with some help from Steve Jenkins) ;;; implicit parameters (define *num-hws* 10) (define *num-tests* 4) ;;; grading policy constants (define *min-fractions* '(("A" 0.90) ("A-" 0.85) ("B+" 0.80) ("B" 0.75) ("B-" 0.70) ("C+" 0.65) ("C" 0.60) ("C-" 0.55) ("D+" 0.50) ("D" 0.45) ("D-" 0.40) ("F" 0.0))) (define *min-c-minus-fract* (cadr (assoc "C-" *min-fractions*))) (define *test-fraction* (/ 2 3)) (define *hw-fraction* (- 1 *test-fraction*)) (define *extra-credits-per-raise* 40) ;;; error message and debugging variables (define *last-good-line* '()) (define *echo-inputs* #f) (define fraction->grade ; TYPE: (-> (number) string) (lambda (frac) ; REQUIRES: 0.0 <= frac <= 1.0 ; ENSURES: result is the string for the course standard grade ; for the given fraction. (letrec ((find-grade ; TYPE: (-> (number (list grade-fraction pairs)) string) (lambda (ls) ; REQUIRES: the fractions in ls are sorted in ; descending order, with the last fraction 0.0 (if (>= frac (cadar ls)) (caar ls) (find-grade (cdr ls)))))) (find-grade *min-fractions*)))) (define grade->fraction ; TYPE: (-> (string) number) (lambda (grade) ; REQUIRES: grade is a course standard grade (not "Incomplete") ; EFFECT: return a fraction right in the middle of the grade scale ; for that letter grade. (if (string-ci=? grade "F") (- (grade->fraction "D-") 0.05) (+ 0.025 (cadr (string-ci-assoc grade *min-fractions*)))))) ;EXAMPLE: ;(grade->fraction "B") ;Value: .775 ;EXAMPLE: ;(grade->fraction "f") ;Value: .37500000000000006 (define string-ci-assoc ; TYPE: (-> (string (association list string number)) (pair string number)) (lambda (str alist) ; ENSURES: result is () if there is no association for str in alist, ; and the association otherwis. The comparison is case independent. (cond ((null? alist) '()) ((string-ci=? str (caar alist)) (car alist)) (else (string-ci-assoc str (cdr alist)))))) ;EXAMPLE: ;(string-ci-assoc "a" *min-fractions*) ;Value: ("A" .9) (define points2grades ; TYPE: (-> (number) (list (pair string natural))) (lambda (possible) ; REQUIRES: possible >= 0 ; ENSURES: each item in result is a list whose first element is a grade, ; and whose second element is the minimum number of points ; needed for that grade. (map (lambda (grade&fraction) (list (car grade&fraction) (floor (* possible (cadr grade&fraction))))) *min-fractions*))) ;;; the abstract data type problem ;;; abstractly, problems are pairs of points and a designator symbol ;;; written (point, designator) (define make-problem ; TYPE: (-> (natural symbol) problem) (lambda (points designator) ; REQUIRES: designator is either 'basic, 'normal, 'suggested, or 'extra ; EFFECT: result is (points, designator) the problem (list points designator))) (define problem->points ; TYPE: (-> (problem) natural) car) (define problem->designator ; TYPE: (-> (problem) symbol) cadr) (define normal-or-basic? ; TYPE: (-> (problem) boolean) (lambda (problem) (or (eq? 'normal (problem->designator problem)) (eq? 'basic (problem->designator problem))))) (define incompletes ; TYPE: (-> (natural (list problem) (list number)) (list natural)) (lambda (problem-num problems earned-list) ; ENSURES: result is a list of problem numbers for which an incomplete ; was earned (cond ((null? problems) '()) ((let ((first-problem (car problems))) (and (eq? 'basic (problem->designator first-problem)) (> *min-c-minus-fract* (/ (car earned-list) (problem->points first-problem))))) (cons problem-num (incompletes (add1 problem-num) (cdr problems) (cdr earned-list)))) (else (incompletes (add1 problem-num) (cdr problems) (cdr earned-list)))))) ;EXAMPLE ;(incompletes 1 '((10 basic) (5 normal) (3 basic) (10 basic) (20 normal) (0 suggested) (30 extra)) '( 7 0 2 1 10 0 0)) ;Value: (4) (define incomplete? ; TYPE: (-> ((list problem) (list number)) boolean) (lambda (problems earned-points) (not (null? (incompletes 1 pxbs earned-points))))) ; EXAMPLE: ;(incomplete? '((10 basic) (5 normal) (3 basic) (10 basic) (20 normal) (0 suggested) (30 extra)) '( 7 0 2 1 10 0 0)) ;Value: #t (define points-earned ; TYPE: (-> ((list problem) (list number)) number) (lambda (problems earned-list) ; REQUIRES: (length problems) = (length earned-list) ; ENSURES: result is the total points earned on normal and basic problems (if (null? problems) 0 (+ (if (normal-or-basic? (car problems)) (car earned-list) 0) (points-earned (cdr problems) (cdr earned-list)))))) ;EXAMPLE: ;(points-earned '((10 basic) (5 normal) (3 basic) (10 basic) (20 normal) (0 suggested) (30 extra)) '( 7 0 2 1 10 0 0)) ;Value: 20 (define extra-credit-points ; TYPE: (-> ((list problem) (list number)) number) (lambda (problems earned-list) ; REQUIRES: (length problems) = (length earned-list) ; ENSURES: result is the total points earned on extra credit problems (if (null? problems) 0 (+ (if (eq? 'extra (problem->designator (car problems))) (car earned-list) 0) (extra-credit-points (cdr problems) (cdr earned-list)))))) ;EXAMPLE: ;(extra-credit-points '((10 basic) (5 normal) (3 basic) (10 basic) (20 normal) (0 suggested) (30 extra)) '( 7 0 2 1 10 0 25)) ;Value: 25 (define points-possible ; TYPE: (-> (list problem) number) (lambda (problems) ; ENSURES: result is the total number of points possible for normal ; and basic problems (if (null? problems) 0 (+ (if (normal-or-basic? (car problems)) (problem->points (car problems)) 0) (points-possible (cdr problems)))))) ;EXAMPLE: ;(points-possible '((10 basic) (5 normal) (3 basic) (10 basic) (20 normal) (0 suggested) (30 extra))) ;Value 48 (define homework-summary ; TYPE: (-> (natural (list problem) (list point)) -> (association list)) (lambda (problem-num problems earned-points) ; ENSURES: result is a 4-element list consisting of the grade, ; the numerical score, the extra-credit points, ; and the list of any incompletes (let ((grade-fraction (/ (points-earned problems earned-points) (points-possible problems))) (incomps (incompletes problem-num problems earned-points))) (let ((grade (if (null? incomps) (fraction->grade grade-fraction) "Incomplete")) (extra (if (null? incomps) (extra-credit-points problems earned-points) 0))) (list (list 'grade grade) (list 'fraction (+ 0.0 grade-fraction)) (list 'extra-credit extra) (list 'incompletes incomps)))))) ;EXAMPLE: ;(homework-summary 1 '((10 basic) (5 normal) (3 basic) (10 basic) (20 normal) (0 suggested) (30 extra)) '( 7 0 2 1 10 0 0)) ;Value: ((grade "Incomplete") (fraction .4166666666666667) (extra-credit 0) (incompletes (4))) ;EXAMPLE: ;(homework-summary 1 '((10 basic) (5 normal) (3 basic) (10 basic) (20 normal) (0 suggested) (30 extra)) '( 7 0 2 10 10 20 25)) ;Value: ((grade "C") (fraction .6041666666666666) (extra-credit 25) (incompletes ())) (define old-grade-estimate ; TYPE: (-> (number (list string) (list string) ; (list boolean) (list boolean)) ; number) (lambda (extra-credit-pts homework tests hw-incompletes test-incompletes) ; REQUIRES: none of the grades in homework or tests are "Incomplete", ; (length hw-incompletes) = (length homework), and ; (length test-incompletes) = (length tests) ; ENSURES: result is the weighted grade, taking extra credit into account ; warning: this assumes all homeworks count equally, and that all tests ; count equally. (grade-estimate extra-credit-pts (map grade->fraction homework) (map grade->fraction tests) hw-incompletes test-incompletes))) ;EXAMPLE: ;(old-grade-estimate 87 '("A" "B" "B+" "B+" "A-" "A-" "A" "A-" "A") '("B" "B+" "A" "B") '(#f #f #f #f #f #f #f #f #f) '(#f #f #f #f)) ;Value: .8564814814814814 (define grade-estimate ; TYPE: (-> (number (list number) (list number) ; (list boolean) (list boolean)) ; number) (lambda (extra-credit-pts homework tests hw-incompletes test-incompletes) ; REQUIRES: each item in homework and tests is between 0.0 and 1.0, ; (length hw-incompletes) = (length homework), and ; (length test-incompletes) = (length tests), and ; (length homework) + (length tests) > 0 ; ENSURES: result is the weighted grade, taking extra credit into account ; warning: this assumes all homeworks count equally, and that all tests ; count equally. (let ((raises (floor (/ extra-credit-pts *extra-credits-per-raise*))) (hws (list->vector homework)) (tsts (list->vector tests)) (a-fraction (- (grade->fraction "A") 0.001)) (hw-length (length homework)) (test-length (length tests))) (let ((hw-weight (cond ((zero? test-length) (/ 1.0 hw-length)) ; no tests, so all weight here ((zero? hw-length) 0.0) (else (* *hw-fraction* (/ 1.0 hw-length))))) (test-weight (cond ((zero? hw-length) (/ 1.0 test-length)); no homework, so all weight here ((zero? test-length) 0.0) (else (* *test-fraction* (/ 1.0 test-length)))))) (letrec ((increase ; TYPE: (-> (natural natural (vector number) ; (list boolean)) ; natural) (lambda (num-raises i grades incompletes) ; REQUIRES: 0 <= i <= (vector-length grades) - 1, ; and (vector-length grades) = (length incompletes), ; and for each 0 <= j < i, ; either (list-ref incompletes j) is #t ; or (vector-ref grades j) >= a-fraction ; MODIFIES: grades ; EFFECT: increase up to num-raises grade entries in grades ; or as many as possible until all grades are ; either incomplete or "A", return the num of raises ; left (if (or (zero? num-raises) (>= i (vector-length grades))) num-raises (if (or (>= (vector-ref grades i) a-fraction) (list-ref incompletes i)) (increase num-raises (add1 i) grades incompletes) (begin (vector-set! grades i (+ 0.05 (vector-ref grades i))) (increase (sub1 num-raises) i grades incompletes)))))) (weighted ; TYPE: (-> ((list number) (list number) number) number) (lambda (hws tsts sum) (cond ((and (null? hws) (null? tsts)) sum) ((null? tsts) (weighted (cdr hws) tsts (+ sum (* (car hws) hw-weight)))) (else (weighted hws (cdr tsts) (+ sum (* (car tsts) test-weight)))) )))) (begin (set! raises (increase raises 0 tsts test-incompletes)) (increase raises 0 hws hw-incompletes) (weighted (vector->list hws) (vector->list tsts) 0.0))))))) ;EXAMPLE: ;(grade-estimate 87 '(0.9 0.83 0.844 0.89 0.89 0.84999 1.0 0.85 0.95) '(0.75 0.798 0.91 0.823) '(#f #f #f #f #f #f #f #f #f) '(#f #f #f #f)) ;Value: .859944074074074 ;(fraction->grade .859944074074074) ;Value: "A-" ;EXAMPLE ;(grade-estimate 87 '(0.9 0.83 0.844 0.89 0.89 0.84999 1.0 0.85 0.95) '(0.1 0.298 0.2 0.21) '(#f #f #f #f #f #f #f #f #f) '(#f #f #f #f)) ;Value: .44777740740740746 ;(fraction->grade .447) ;Value: "D-" ;EXAMPLE ;(grade-estimate 87 '(0.775 0.775 0.775 0.775 0.775 0.775 0.775 0.775 0.775) '(0.775 0.775 0.775 0.775) '(#t #t #t #t #t #t #t #t #t) '(#t #t #t #t)) ;Value: .7749999999999997 ;(fraction->grade .7749999999999997) ;Value: "B" (define grade-estimate-report ; TYPE: (-> ((list (tuple name number number (list number) (list number) ; (list boolean) (list boolean)))) ; (list (tuple name number grade))) (lambda (students) ; REQUIRES: for each record in the list, call the fields: ; name extra-credits homework tests hw-incompletes test-incompletes ; each of homework and tests is between 0.0 and 1.0, ; (length hw-incompletes) = (length homework), and ; (length test-incompletes) = (length tests) ; ENSURES: result is list of name, that student's weighted grade, ; and that student's letter grade ; warning: this assumes all homeworks count equally, and that all tests ; count equally. (map (lambda (student) (let ((name (list-ref student 0)) (ssnum (list-ref student 1)) (extra-credits (list-ref student 2)) (homework (list-ref student 3)) (tests (list-ref student 4)) (hw-incompletes (list-ref student 5)) (test-incompletes (list-ref student 6))) (let ((fraction (grade-estimate extra-credits homework tests hw-incompletes test-incompletes))) (list name ssnum fraction (fraction->grade fraction))))) students))) (define set-hw-test-nums! ; TYPE: (-> () void) (lambda () ; MODIFIES: *num-hws*, *num-tests* ; EFFECT: prompt for the number of homeworks and tests, and change ; their global values. (set! *num-hws* (prompt-nat "(remembering hw0) how many homeworks do you have grades for? ")) (set! *num-tests* (prompt-nat "how many tests do you have grades for? ")))) (define make-grade-estimates ; TYPE: (-> () (list (tuple name number grade))) (lambda () ; MODIFIES: *num-hws*, *num-tests* ; EFFECT: prompt for the number of homeworks and tests ; and a file name and produce a grade report for it. (set-hw-test-nums!) (set! *last-good-line* '()) (let ((fn (prompt-str "what file? (type it in quotes) "))) (grade-estimate-report (with-input-from-file fn (read-every-line (if (prompt-yes/no "Does the file have names (not just id numbers) in it? ") read-name dummy-read-name))))))) (define read-every-line ; TYPE: (-> ((-> () name)) ; (-> () (list (tuple name number (list number) (list number) ; (list boolean) (list boolean))))) (lambda (read-name) (letrec ((read-every-line ; TYPE: (-> () (list (tuple name number (list number) (list number) ; (list boolean) (list boolean))))) (lambda () ; EFFECT: returns list of input in the format for ; grade-estimate-report from the current input port (let ((name (read-name))) (if (eof-object? name) '() (let ((a-line (read-one-line name))) (if *echo-inputs* (writeln a-line)) (set! *last-good-line* a-line) ; for error messages (cons a-line (read-every-line)))))))) read-every-line))) (define read-one-line ; TYPE: (-> (name) (tuple name number (list number) (list number) ; (list boolean) (list boolean))) (lambda (student-name) ; EFFECT: returns a student record from the current input port ; BUGS: no error checking (let* ((ssnum (read)) (extra-credit-points (read)) (hw-fractions (read-a-number-list *num-hws*)) (test-fractions (read-a-number-list *num-tests*)) (hw-incompletes (read-a-boolean-list *num-hws*)) (test-incompletes (read-a-boolean-list *num-tests*))) (list student-name ssnum extra-credit-points hw-fractions test-fractions hw-incompletes test-incompletes)))) (define read-name ; TYPE: (-> () name) ; EFFECT: return name read from the current input port read) (define dummy-read-name ; TYPE: (-> () name) (lambda () ; EFFECT: return a dummy name, if there is input on the current input port (eat-whitespace!) (let ((pc (peek-char))) (if (eof-object? pc) pc "no-name")))) (define eat-whitespace! ; TYPE: (-> () void) (lambda () ; EFFECT: eat whitespace characters from the current input port (let ((pc (peek-char))) (if (not (or (eof-object? pc) (not (char-whitespace? pc)))) (begin (read-char) (eat-whitespace!)))))) (define read-a-list ; TYPE: (-> ((-> (datum) boolean) string) (-> (natural) (list datum))) (lambda (type-pred type-name) (letrec ((read-a-list-help (lambda (len) ; EFFECT: return a list of len items read from the current input ; port or if one of the items read does not pass type-pred, signal ; an error. (if (zero? len) '() (let ((it (read))) (if (type-pred it) (cons it (read-a-list-help (sub1 len))) (error (string-append "expecting a " type-name " got ") it "\nlast good line was: " *last-good-line* ))))))) read-a-list-help))) (define read-a-boolean-list (read-a-list boolean? "boolean")) (define read-a-number-list (read-a-list number? "number")) ;;; prompting (define prompt ; TYPE: (-> (string (-> (datum) boolean) string) T) (lambda (T? type-name) (lambda (prompt-string) ; REQURIES: (T? x) is true iff x has type T ; EFFECT: prompt with prompt-string, read an item from ; the current input port, check that it has type T. ; If it has the right type, return it, otherwise give an error (letrec ((get-it ; TYPE: -> T (lambda () ; EFFECT: prompt and read from the current input port ; until a satisfactory input is given (display prompt-string) (let ((ans (read))) (if (T? ans) ans (begin (writeln "please enter input of type " type-name " instead of " ans) (get-it))))))) (get-it))))) (define prompt-nat (prompt (lambda (x) (and (integer? x) (or (zero? x) (positive? x)))) "natural")) (define prompt-num (prompt number? "number")) (define prompt-fract (prompt (lambda (x) (and (number? x) (<= 0 x) (<= x 1))) "fraction between 0 and 1")) (define prompt-str (prompt string? "string")) ;(define prompt-datum (prompt (lambda (x) #t) "datum")) (define prompt-bool (prompt boolean? "boolean")) (define prompt-yes/no (prompt (lambda (x) (case x ((y yes n no) #t) (else #f))) "yes or no")) (define yes/no->boolean ; TYPE: (-> (symbol) boolean) (lambda (yn) (case yn ((y yes) #t) ((n no) #f) (else (error "input not a boolean"))))) (define writeln ; TYPE: (-> (datum ...) void) (lambda args (for-each display args) (newline))) (define prompt-for-n ; TYPE: (-> ((-> (string) T)) (-> (string natural natural) (list T))) (lambda (prompt-for-T) ; REQUIRES: (prompt-for-T s) prompts with s and returns a T ; ; read from the current input port ; EFFECT: (result s start end) prompts with s, ; and then reads (start-end+1) items from the ; current input port and returns them in a list, in order (lambda (prompt-string start end) (letrec ((read-nth ; TYPE: (-> (natural) (list T)) (lambda (i) ; EFFECT: read the ith through endth elements from current ; input port and return them in a list (if (> i end) '() (let ((it (prompt-for-T (string-append "number " (number->string i) "? ")))) (cons it (read-nth (add1 i)))))))) (writeln prompt-string) (read-nth start))))) (define prompt-for-n-fract (prompt-for-n prompt-fract)) (define prompt-for-n-bool (prompt-for-n prompt-bool)) (define xerox ; TYPE: (-> (T natural) (list T)) (lambda (x n) ; ENSURES: result is a list of n copies of x (if (zero? n) '() (cons x (xerox x (sub1 n)))))) (define pad-on-right ; TYPE: (-> (string) (-> (natural) (-> (string) string))) (lambda (pad) (lambda (n) (lambda (str) ; REQUIRES: (string-length pad) > 0 ; ENSURES: result is str padded on the right with pad ; to be at least n chars long (letrec ((loop ; TYPE: (-> (string) string) (lambda (str) (if (>= (string-length str) n) str (loop (string-append str pad)))))) (loop str)))))) (define pad-on-right-blank (pad-on-right " ")) (define interactive-grade-estimate ; TYPE: (-> (boolean) void) (lambda () ; MODIFIES: *num-hws*, *num-tests* ; EFFECT: prompt for information, and print the weighted score, ; and an estimate of the student's grade ; BUGS: no error checking (set-hw-test-nums!) (let* ((extra-credit-points (prompt-num "total extra credit points? ")) (hw-fractions (prompt-for-n-fract "fractions for homeworks" 0 (sub1 *num-hws*))) (test-fractions (prompt-for-n-fract "fractions for tests" 1 *num-tests*)) (any-incompletes (yes/no->boolean (prompt-yes/no "Did you have any incompletes? ")))) (let* ((hw-incompletes (if any-incompletes (prompt-for-n-bool "incomplete on homeworks (#t if incomplete, #f otherwise)" 0 (sub1 *num-hws*)) (xerox #f *num-hws*))) (test-incompletes (if any-incompletes (prompt-for-n-bool "incomplete on tests (#t if incomplete, #f otherwise)" 1 *num-tests*) (xerox #f *num-tests*)))) (let ((input-data (list extra-credit-points hw-fractions test-fractions hw-incompletes test-incompletes))) (writeln "Your input was as follows:") (writeln "(Extra-Credit (Homeworks) (Tests) " "(HW-incompletes) (Test-incompletes))") (write input-data) (newline) (newline) (let* ((pad-it (pad-on-right-blank (add1 (string-length (number->string (/ 1.0 3.0)))))) (col-print ; TYPE: (-> ((list string)) void) (lambda (str-list) (for-each (lambda (str) (display (pad-it str))) str-list) (newline)))) (col-print '("Weighted Avg." "Grade")) (col-print (map (lambda (x) (if (number? x) (number->string x) x)) (cddr (car (grade-estimate-report (list (cons "I.G. Nored" (cons 123456 input-data)))))))) ))))))