#! /usr/bin/env perl

#This program will process a file of individual grade entries
#into a final grade for 18.03 according to the algorithm layed out
#by Prof Miller in his email on 11 May 2004.

@pset_totals = (60,75,45,52,86,60,45,45);
@exam_totals = (100,100,100);
$final_total = (300);
%gradecuts = ('A'=>245,'B'=>200,'C'=>150,'D'=>125,'F'=>0);

# will run quietly and without final exam in input/output
$verbose=0;
$with_final=0;
$with_grading=0;

while($_ = <STDIN>) {
#File format is a sequence of records, each record will be
#four lines, but right now we have three:
# Student Name
    s/^\s+//; s/\s+$//;
    $Student = $_;
    if ($verbose>1) {print "processing $Student\n"}

# problem set scores (separated by whitespace)
    $_ = <STDIN>;
    s/^\s+//; s/\s+$//;
    my @psets = split(/\s+/);
    my ($pset_score,$pset_drop) = &process_psets(@psets);
    my $pset_score = &round($pset_score);

# exam scores (separated by whitespace)
    $_ = <STDIN>;
    s/^\s+//; s/\s+$//;
    my @exams = split(/\s+/);
    my $exam_score = &round(&process_exams(@exams));

# final exam score
    my ($final,$final_score);
    if ($with_final) {
	$_ = <STDIN>;
	s/^\s+//; s/\s+$//;
	$final = $_;
	$final_score = &round(&process_final($final));
    }

    if ($with_final) {
	my $total = $pset_score + $exam_score + $final_score;
	$line = "$Student\t$pset_score\t$exam_score\t$final_score\t$total";
	print "$line\n";
	if ($with_grading) { push(@tograde,$line) }
    }
    else {
	print "$Student\t$pset_score\t$exam_score\n";
    }

# this just helps find anomalies
#    my @ps=@psets;
#    my @pst=@pset_totals;
#    for (@ps) {print " ",int(100*($_/shift(@pst))),"\%"}
#    print "\n";

    print "psets: ",join(" ",@psets);
    if ($verbose) {print " (dropped pset $pset_drop)"}
    print "\n";
    print "exams: ",join(" ",@exams),"\n";
    if ($with_final) {print "final: ",$final,"\n"}
}

# grades are computed as per prof Miller's method.  Ties are
# broken by giving both the higher grade (this won't happen
# often anyway).
# This program marks +'s and -'s on the highest/lowest scoring
# grades within that letter group (as singleton score thus is
# marked with an annoying '+-').
if ($with_grading) {
    my $nstudents = $#tograde+1;
    my @letters = ();
    my @scores = ();
    for (@tograde) {
	my ($s,$p,$e,$f,$t) = split("\t");
	push(@scores,$t);
	for (sort keys %gradecuts) {
	    if ($f >= $gradecuts{$_}) {
		push(@letters,$_);
		last;
	    }
	}
    }
    @letters = sort @letters;
    @scores  = sort {$b <=> $a} @scores;
    if ($#scores != $#letters) {
	print STDERR "something is broken\n";
	exit(27);
    }
    my %assign = ();
    my ($lastscore,$lastletter) = ('','');
    for (@scores) {
	my $let = shift(@letters);
	$assign{$_} = $let;
	if ($let ne $lastletter) {
	    $assign{$_} .= '+';
	    $assign{$lastscore} .= '-';
	}
	$lastscore = $_;
	$lastletter= $let;
    }
    for (@tograde) {
	my ($s,$p,$e,$f,$t) = split("\t");
	print "GRADE:$_\t$assign{$t}\n";
    }
}

sub process_psets {
# there must be eight problem set entries in non-corrupt input
    if (@_ != @pset_totals) {
	print STDERR "There are ",int(@_),"/",int(@pset_totals)," problem sets for: $Student\n";
	print STDERR "Please correct this and re-run the analysis.\n";
	exit(1);
    }
# all entries must be numeric in non-corrupt input
    my @tmp = @pset_totals;
    for (@_) {
	my $tot = shift(@tmp);
	if (&nonnumeric($_)) {
	    print STDERR "There is a non-numeric problem set entry for: $Student\n";
	    print STDERR "of the form '$_'.\n";
	    print STDERR "Please correct this and re-run the analysis.\n";
	    exit(2);
	}
	if ($_ < 0 or $_ > $tot) {
	    print STDERR "A problem set score=$_ is out of bounds [0,$tot] for: $Student\n";
	    print STDERR "Please correct this and re-run the analysis.\n";
	    exit(5);
	}
    }
# total number of points is now calculated
    my $total = 0;
    for (@_) {$total += $_}
    my $total_tot = 0;
    for (@pset_totals) {$total_tot += $_}

# find the best pset to drop
    my $best_dropped = 0;
    my $pset_to_drop  = -1;
    for $i (0..$#_) {
	# if we drop pset i, then the score will be
	# (total - psetscore[i])*(300/(408-psettotal[i]))

	my $dropped = $total;
	$dropped -= $_[$i];
	$dropped *= (300.0)/($total_tot-$pset_totals[$i]);

# save best dropped score and record which pset to drop
	if ($dropped > $best_dropped) {
	    $best_dropped = $dropped;
	    $pset_to_drop = $i+1;
	}
    }
    if ($pset_to_drop == -1) {
	print STDERR "Unable to find a good problem set to drop.\n";
	print STDERR "This smells like a bug.\n";
	exit(7);
    }

# we can now report the pset score
    return ($best_dropped,$pset_to_drop);
}




sub process_exams {
# there must be three exam entries in non-corrupt input
    if (@_ != @exam_totals) {
	print STDERR "There are ",int(@_),"/",int(@exam_totals)," exams for: $Student\n";
	print STDERR "Please correct this and re-run the analysis.\n";
	exit(3);
    }
# all but one entry must be numeric in non-corrupt input
    my $missing = -1;
    my $exam=0;
    my @tmp = @exam_totals;
    for (@_) {
	my $tot = shift(@tmp);
	if (&nonnumeric($_)) {
# missing exams are filled in by averaging (assuming they are excused)
	    if ($verbose>1) {
		print "There is a non-numeric exam entry for: $Student\n";
		print "of the form '$_'.\n";
	    }
	    if ($missing != -1) {
		print STDERR "More than one non-numeric exam entry for: $Student\n";
		print STDERR "Please correct this and re-run the analysis.\n";
		exit(4);
	    }
	    $missing = $exam;
	}
	$exam++;
	if ($_ < 0 or $_ > $tot) {
	    print STDERR "An exam score=$_ is out of bounds [0,$tot] for: $Student\n";
	    print STDERR "Please correct this and re-run the analysis.\n";
	    exit(5);
	}
    }
# if an exam is missing then we average according to the email:
    @scores = @_;
#If the missing exam was II,     record (1.125)*(average of other two)
#If the missing exam was not II, record (0.941)*(average of other two)
    if ($missing == 0) {$scores[0] = (0.941)*($scores[1]+$scores[2])*0.5 }
    if ($missing == 1) {$scores[1] = (1.125)*($scores[0]+$scores[2])*0.5 }
    if ($missing == 2) {$scores[2] = (0.941)*($scores[0]+$scores[1])*0.5 }

# compute totals
    my $total = 0;
    for (@scores) {$total += $_}
    my $total_tot = 0;
    for (@exam_totals) {$total_tot += $_}

    $score = 300.0*$total/(1.0*$total_tot);
    return $score;
}



sub process_final {
# there must be 1 final entry in non-corrupt input
    $_ = shift(@_);
    if (&nonnumeric($_)) {
	print STDERR "There is a non-numeric final entry for: $Student\n";
	print STDERR "of the form '$_'.\n";
	print STDERR "Please correct this and re-run the analysis.\n";
	exit(2);
    }
    if ($_ < 0 or $_ > $final_total) {
	print STDERR "A final score=$_ is out of bounds [0,$final_total] for: $Student\n";
	print STDERR "Please correct this and re-run the analysis.\n";
	exit(5);
    }
    return $_;
}

sub round {return int(shift(@_)+0.5)}

sub nonnumeric {$_ = shift(@_); return !/^\d+(\.\d*)?$/}