Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

grading stuff

  • Loading branch information...
commit 6c71abf4023fc6bcda9fd525ec64ce7347c9dd6d 1 parent ddf73cd
Arjun Guha authored
View
134 grading/consolidate-grades.rkt
@@ -0,0 +1,134 @@
+#lang racket
+
+(require (only-in 2htdp/batch-io read-csv-file))
+
+(define (filter-indices pred lst)
+ (letrec ([f (lambda (n lst)
+ (if (empty? lst)
+ empty
+ (if (pred (first lst))
+ (cons n (f (add1 n) (rest lst)))
+ (f (add1 n) (rest lst)))))])
+ (f 0 lst)))
+
+(define (index-of elt lst)
+ (letrec ([f (lambda (n lst)
+ (if (empty? lst)
+ #f
+ (if (equal? elt (first lst))
+ n
+ (f (add1 n) (rest lst)))))])
+ (f 0 lst)))
+
+(define assignment-order '("rinterp" "xinterp" "subst-writ" "lazy-prog" "lazy-writ" "web" "written-cont" "gc-writ"
+ "gc-prog" "typec" "type-writ" "typei" "websand" "prolog"))
+
+(define (csv-file? p)
+ (and (file-exists? p)
+ (regexp-match? #rx"\\.csv$" (path->string p))))
+
+(define (normalize-list-length len pad-val lst)
+ (if (zero? len)
+ empty
+ (cons
+ (if (empty? lst)
+ pad-val
+ (first lst))
+ (normalize-list-length (sub1 len) pad-val (rest lst)))))
+
+(define (login-label? s)
+ (or (zero? (string-length s))
+ (regexp-match? #rx"((L|l)ogin)|((U|u)sername)|Name|Partner" s)))
+
+(define (grade-label? s)
+ (and (regexp-match? #rx"((G|g)rade)|((T|t)otal)" s)
+ ; omg, why do you guys write this?
+ (not (regexp-match #rx"(G|g)rader" s))))
+
+(define skipped-columns empty)
+
+(define (classify-label s)
+ (let ([login? (login-label? s)]
+ [grade? (grade-label? s)])
+ (cond
+ [(and login? grade?) (error (format "ambigious label ~a" s))]
+ [login? 'login]
+ [grade? 'grade]
+ [else
+ (begin
+ (set! skipped-columns (cons s skipped-columns))
+ 'skip)])))
+
+(define-struct solution (logins assignment grade) #:transparent)
+
+(define (grade-csv->records asgn csv-data)
+ (let* ([labels (first csv-data)]
+ [rows (rest csv-data)]
+ [num-labels (length labels)]
+ [classified-labels (map classify-label labels)]
+ [grade-index
+ (let ([ixs (filter-indices (lambda (k) (symbol=? k 'grade)) classified-labels)])
+ (if (= 1 (length ixs))
+ (first ixs)
+ (error (format "multiple grades found for ~a" asgn))))]
+ [login-indices (filter-indices (lambda (k) (symbol=? k 'login)) classified-labels)])
+ (for/list ([unpadded-row (in-list rows)])
+ (let ([row (normalize-list-length num-labels "" unpadded-row)])
+ (solution (map (lambda (ix) (list-ref row ix)) login-indices)
+ asgn
+ (string->number (list-ref row grade-index)))))))
+
+(define all-grade-files (filter csv-file? (directory-list)))
+
+(define assoc-assignment->csv-data
+ (map (lambda (p) (cons (path->string (path-replace-suffix p "")) (read-csv-file (path->string p)))) all-grade-files))
+
+; All grades
+(define grades
+ (apply append
+ (map
+ (lambda (kv)
+ (let ([asgn (first kv)]
+ [csv-data (rest kv)])
+ (grade-csv->records asgn csv-data)))
+ assoc-assignment->csv-data)))
+
+
+(define-struct student (login grades) #:transparent)
+
+
+(define (make-student-record login)
+ (let ([student-grades (filter (lambda (s) (member login (solution-logins s))) grades)])
+ (student login
+ (make-immutable-hash (map (lambda (s) (cons (solution-assignment s) (solution-grade s))) student-grades)))))
+
+(define students
+ (sort
+ (for/list ([login (in-hash-keys (for/hash ([login (apply append (map solution-logins grades))])
+ (values login #t)))])
+ (make-student-record login))
+ (lambda (s1 s2)
+ (string<=? (student-login s1) (student-login s2)))))
+
+
+(define asgns (sort (map (lambda (p) (path->string (path-replace-suffix p ""))) all-grade-files)
+ (lambda (as1 as2)
+ (<= (index-of as1 assignment-order)
+ (index-of as2 assignment-order)))))
+
+(with-output-to-file
+ "../all-grades.csv"
+ #:exists 'replace
+ (lambda ()
+ (printf ",")
+ (for ([asgn (in-list asgns)])
+ (printf "~a," asgn))
+ (printf "~n")
+
+ (for ([stu (in-list students)])
+ (printf "~a," (student-login stu))
+ (for ([asgn (in-list asgns)])
+ (printf "~a," (hash-ref (student-grades stu) asgn "")))
+ (printf "~n"))))
+
+
View
125 grading/grading.rkt
@@ -0,0 +1,125 @@
+#!/usr/bin/env racket
+#lang racket
+
+(require (only-in 2htdp/batch-io read-csv-file))
+
+(define racket-path "/Developer/Racket\\ v5.0.1/bin/racket")
+
+; submission: path -> boolean
+(define (submission? p)
+ (and (directory-exists? p)
+ (regexp-match? #rx"^[^ _].*$" (path->string p))))
+
+; submission-dirs : (listof string)
+(define submission-dirs
+ (map path->string (filter submission? (directory-list))))
+
+(define (check-for . filenames)
+ (let ([missing? #f])
+ (begin
+ (for ([submission-dir (in-list (filter submission? (directory-list)))])
+ (for ([filename (in-list filenames)])
+ (when (not (file-exists? (build-path submission-dir filename)))
+ (set! missing? #t)
+ (printf "~a missing from ~a~n" filename (path->string submission-dir)))))
+ (when (not missing?)
+ (printf "All files found.~n")))))
+
+(define (path->filename path)
+ (if (file-exists? path)
+ (let-values ([(_ name __) (split-path path)])
+ name)
+ (error 'path->filename "file not found: ~a" path)))
+
+
+(define (confirm! msg)
+ (display (string-append msg " (y/n)\n"))
+ (flush-output)
+ (case (read-char)
+ ([#\Y #\y] (void))
+ ([#\N #\n] (error 'confirm "terminated"))
+ [else (confirm! msg)]))
+
+(define (overwrite! filename)
+ (when (file-exists? filename)
+ (confirm! (format "overwrite ~a" filename))
+ (delete-file filename)))
+
+(define (run-tests . original-tests)
+ (for ([submission-dir (in-list (filter submission? (directory-list)))])
+ (for ([original-test-file (in-list original-tests)])
+ (let* ([test-file (path->filename original-test-file)]
+ [new-test-file (path->string (build-path submission-dir test-file))]
+ [test-file-stdout (string-append new-test-file "-stdout.txt")]
+ [test-file-stderr (string-append new-test-file "-stderr.txt")])
+ (begin
+ (overwrite! new-test-file)
+ (overwrite! test-file-stdout)
+ (overwrite! test-file-stderr)
+ (copy-file original-test-file new-test-file)
+ (let ([stdout (open-output-file test-file-stdout)]
+ [stderr (open-output-file test-file-stderr)])
+ (printf "Running ~a ...~n" new-test-file)
+ (dynamic-wind
+ void
+ (lambda ()
+ (parameterize
+ ([current-output-port stdout]
+ [current-error-port stderr])
+ (with-handlers ([exn:break? (lambda (exn) (printf "*** Terminated early by TA (taking forever) ***~n"))])
+ (system (format "~a ~a" racket-path new-test-file)))))
+ (lambda ()
+ (close-output-port stdout)
+ (close-output-port stderr)))))))))
+
+(define (write-grades max-group-size-str grades.csv)
+ (let* ([max-group-size (string->number max-group-size-str)]
+ [grades-raw (read-csv-file grades.csv)]
+ [categories (first grades-raw)]
+ [all-grades (rest grades-raw)])
+ (for ([group-data (in-list all-grades)])
+ (let* ([group-members (filter (lambda (str) (not (zero? (string-length str)))) (take group-data max-group-size))]
+ [group-dirs (filter directory-exists? group-members)]
+ [group-dir
+ (if (= 1 (length group-dirs))
+ (first group-dirs)
+ (error 'write-grades "no directories / multiple directories for group ~a" group-members))]
+ [grade-file-path (build-path group-dir "grades.txt")])
+ (overwrite! grade-file-path)
+ (with-output-to-file
+ grade-file-path #:exists 'replace
+ (lambda ()
+ (pretty-print (map list categories group-data))))))))
+
+
+(define (tar)
+ (for ([submission-dir (in-list (filter submission? (directory-list)))])
+ (printf "Creating ~a.tar ...~n" submission-dir)
+
+ (local ([define-values (sub out in err)
+ (subprocess (open-output-file
+ (build-path "_handbacks"
+ (string->path (string-append (path->string submission-dir) ".tar"))))
+ (current-input-port)
+ (current-error-port)
+ "/usr/bin/tar"
+ "-c"
+ (path->string submission-dir))])
+ (subprocess-wait sub))))
+
+(define action
+ (lambda args
+ (printf "no argument specified (--help for help)~n")))
+
+(command-line
+ #:once-any
+ [("--check-for") "Check all submission directories for files."
+ (set! action check-for)]
+ [("--run-tests") "Run tests."
+ (set! action run-tests)]
+ [("--write-grades") "Read from CSV file and write grades, given a max. group size"
+ (set! action write-grades)]
+ [("--tar") "tars submission directories to _handbacks"
+ (set! action tar)]
+ #:args argv (apply action argv))
+
View
20 grading/handback.sh
@@ -0,0 +1,20 @@
+#!/bin/bash
+
+HANDBACKDIR=$1
+
+for BALL in $HANDBACKDIR/*.tar; do
+ STUDENT=`basename $BALL ".tar"`
+ echo "Emailing $BALL"
+ /usr/bin/mutt -s "[CS173] prolog graded" \
+ -a "$BALL" \
+ "$STUDENT@cs.brown.edu, brown-cs173-testfest@googlegroups.com" <<DONE
+The attached tarball contains your graded solution to prolog.
+An explanation of grading was sent via the TA list.
+Any questions, email cs173tas.
+
+(My apologies if you get this twice.)
+
+Arjun
+DONE
+
+done
Please sign in to comment.
Something went wrong with that request. Please try again.