# script to semi-automate homework grading 

# IMPORTANT DIRECTIONS:

# 1.  All student files must be named in the format studentemail (where
# the e-mail address is written minus the "@ucdavis.edu").  Have all of
# them in the current directory, with no other .txt files present.

# 2.  The format of a student file is required to be as follows:

# The file alternates between one line of problem number and a SINGLE
# line of answer.  The problem number line of problem n must be #n, with
# a suffix of a, b etc. for parts, if any.  The answer line for a
# numeric problem ("type N" below) must be executable R code.

# For example, Say Problem 1 has the answer 3 times (2/17), Problem 2(a)
# and 2(b) have the answers 8 and 88, and Problem 3 consists of filling
# in two blanks in code, with answers "x*y" and "if".  Say Problem 4 is
# a multiple-choice problem, with answer (b).  The student answers file
# would then consist of

#  #1
#  3 * (2/17)
#  #2a
#  8
#  #2b
#  88
#  #3a
#  x*y
#  #3b
#  if
#  #4
#  (b)

# Note that there are no blank lines.

# 3.  There are three problem types-- N for numeric, C for code, S
# otherwise (e.g. answers to multiple choice questions).  In the N case,
# the student must write executable R code.  (Currently C is treated as
# S.)

# 4.  The Answers file, in this same directory, also alternates problem
# number lines with answer lines.  In the former, the problem number is
# followed by the problem type (N for numeric, C for code, S otherwise)
# and the point total for the problem.  

# The Answers file for the above example would look like this: 

#  #1 N 10
#  3 * (2/17)
#  #2a N 20
#  8
#  #2b N 20
#  88
#  #3a C 15
#  x*y
#  #3b C 15
#  if
#  #4 S
#  (b)

# The student writes 00 if he did not answer on the paper
# version, and writes Nothing in a Code answer if he believes code
# should be filled in to that blank.

# 5.  Run the script from the same directory.  For each student file,
# the function will print the e-mail address and grades (scores on each
# problem, and total, plus a 10-point bonus) to stdout.

# usage:  
#
#    call grader() to get the scores
#    call calcltrgrades() to get the lettergrades
#    call emailresults() to mail out the results
#
#    important note: after each of the calls to grader() and
#    calcltrgrades(), the R variable output is saved to the file outfile
#    (in R object format); the latter can be copied to another machine
#    before calling emailresults()

# if the student file has format errors, the program opens the file in
# vim, and the user may attempt to fix it; if fixed, the user will
# specify a smaller bonus value than 10; if the user is not able to
# easily fix the file, he assigns a bonus of 0, which is a signal to not
# grade this file via the script

# globals
#
#    quiznum:  quiz number (Quiz 1, Quiz 2 etc.)
#    answerslist:  all data derived from the official Answers file
#    studentlines:  contents of the student answers file
#    output:  quiz results minus letter grades

gettrueans <- function() {
   answerslist <<- list()
   answersfile <- paste("Answers",quiznum,sep="")
   lines <- scan(file=answersfile,what="",sep="\n",quiet=T)
   nproblems <- length(lines) / 2
   answerslist$nproblems <<- nproblems
   answerslist$probnum <<- vector(mode="character",length=nproblems)
   answerslist$ans <<- vector(mode="character",length=nproblems)
   answerslist$probtype <<- vector(mode="character",length=nproblems)
   answerslist$points <<- vector(mode="integer",length=nproblems)
   for (i in 1:answerslist$nproblems) {
      l <- lines[2*i-1]
      answerslist$ans[i] <<- lines[2*i]
      answerslist$probnum[i] <<- strsplit(l," ")[[1]][1]
      answerslist$probtype[i] <<- strsplit(l," ")[[1]][2]
      answerslist$points[i] <<- strsplit(l," ")[[1]][3]
   }
}

readstudentfile <- function(sfl) {
   studentlines <<- scan(file=sfl,what="",sep="\n",quiet=T)
}

# grade the i-th problem (counting subparts separately), using lines
# from the student answer file
gradestudentans <- function(i) {
   studentans <- studentlines[2*i]
   studentanscopy <- studentans
   realans <- answerslist$ans[i]
   fullpts <- answerslist$points[i]
   if (answerslist$probtype[i] == "N") {
      studentans <- evalstring(studentans)
      realans <- evalstring(realans)
   }
   probnum <- answerslist$probnum[i]
   cat(probnum,"  student original:",studentanscopy,"\n")
   cat(probnum,"  student evaluated:",studentans,"\n")
   cat(probnum,"  true evaluated:",realans,"\n")
   fullpts <- answerslist$points[i]
   resp <- readline(paste("give ",fullpts, "?  "))
   if (resp == "") pts <- fullpts else pts <- resp
}

# check studentlines lines for format errors, returning 1 if OK, 0 else
studentfileok <- function() {
   # correct number of lines?
   nslines <- length(studentlines)
   if (nslines != 2 * answerslist$nproblems) {
      print("wrong line count")
      return(0)
   }
   # do problem numbers and answers alternate, one each at a time?
   for (i in 1:nslines) {
      tmp <- strsplit(studentlines[i]," ")[[1]][1]
      firstchar <- substr(tmp,1,1)
      if (i %% 2 == 1 && firstchar != "#") { 
          print("number, answer lines don't alternate correctly")
          return(0)
      }
   }
   # in an "N" problem, does the R parse correctly?
   for (i in 1:answerslist$nproblems) {
      if (answerslist$probtype[i] == "N") {
         tmp <- try(evalstring(studentlines[2*i]))
         if (class(tmp) == "try-error") {
            print("R parse error")
            return(0)
         }
      }
   }
   return(1)
}

tryfix <- function(sfl) {
   # open student file for possible fix
   xcmd <- paste("xterm -e vi ",sfl," &")
   system(xcmd)
   while (T) {
      resp <- readline("re-read student file? ")
      if (resp == "y") {
         readstudentfile(sfl) 
         if (studentfileok()) break
      } else break
   }
   return(as.integer(readline("bonus amount:  ")))
}

grader <- function() {
   # is this Quiz 1, Quiz 2, or what?
   quiznum <<- readline("enter quiz number: ") 
   gettrueans()  # sets up R list trueans
   output <<- vector(mode="character")
   for (sfl in list.files(pattern="*.txt")) {  
      emailaddr <- substr(sfl,1,(nchar(sfl)-4))
      cat("\n\n","  now grading",emailaddr,"\n")
      total <- 0
      outputline <- emailaddr
      readstudentfile(sfl)
      sflok <- studentfileok()
      if (sflok == 0) {
         bonus <- tryfix(sfl)  
         if (bonus == 0) next
      } else bonus <- 10
      # display entire student file, e.g. to see if answers in a code
      # problem work correctly together even though approach is different 
      # from mine
      # for (sln in studentlines) print(sln)
      total <- 0
      for (i in 1:answerslist$nproblems) {
         score <- gradestudentans(i)
         outputline <- 
            paste(outputline," ", score,"/",answerslist$points[i],sep="")
         total <- total + as.integer(score)
      }
      outputline <- paste(outputline," bonus = ",bonus," ",sep="")
      total <- total + bonus
      outputline <- paste(outputline,"total =",total)
      print(outputline)
      output <<- c(output,outputline)
   }
   if (readline("need to edit? ") == "y") output <<- edit(output)
   cat("\n","results:","\n")
   save(output,file="outfile")
   for (i in 1:length(output)) {
      cat(output[i],"\n")
   }
}

calcltrgrades <- function() {
   load("outfile")
   tmp <- readline("enter cutoffs, e.g. 95 A+ 85 A 70 B...0: ")
   tmp <- strsplit(tmp," ")[[1]]
   inds <- 1:length(tmp)
   evens <- inds[inds %% 2 == 0]
   odds <- inds[inds %% 2 == 1]
   ltrgrades <- tmp[evens]
   cutoffs <- as.integer(tmp[odds])
   totcol <- length(strsplit(output[1]," ")[[1]]) 
   for (i in 1:length(output)) {
      total <- strsplit(output[i]," ")[[1]][totcol]
      total <- as.integer(total)
      ltrgrd <- num2ltr(total,cutoffs,ltrgrades)
      output[i] <- paste(output[i],ltrgrd)
   }
   # save to file for records
   save(output,file="outfile")
   write(output,file=paste("Quiz",quiznum,"Grades",sep=""))
   cat("\n","  letter grade results:","\n")
   for (i in 1:length(output)) {
      cat(output[i],"\n")
   }
   print("if not grading in office, upload outfile and QuiznGrades")
}

emailresults <- function() {
   load("outfile")
   for (l in output) {
      tmp <- strsplit(l," ")[[1]]
      emailaddr <- tmp[1]
      emailaddr <- paste(emailaddr,"@ucdavis.edu",sep="")
      cat(l,file="onestudent")
      tosend <- paste("mutt",emailaddr,"-s 'quiz results' < onestudent")
      system(tosend)
      system("/bin/rm onestudent")
   }
}

num2ltr <- function(tot,cuts,lgs) {
   for (i in 1:length(cuts)) {
      if (tot >= cuts[i]) return(lgs[i])
   }
   return("F")
}

evalstring <- function(toexec) {
   cat(toexec,file="tmpexec")
   sourceresult <- try(source("tmpexec"))
   if (class(sourceresult) == "try-error" || 
       !is.numeric(sourceresult$value)) {
      print("R parse error")
      return(NA)
   } else return(sourceresult$value)
}