File Coverage

blib/lib/Grades.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Grades;
{
  $Grades::VERSION = '0.16';
}

#Last Edit: 2014  2月 15, 16時23分02秒
#$Id: Grades.pm 1960 2014-02-15 08:27:09Z drbean $

use MooseX::Declare;

package Grades::Script;
{
  $Grades::Script::VERSION = '0.16';
}
use Moose;
with 'MooseX::Getopt';

has 'man' => (is => 'ro', isa => 'Bool');
has 'help' => (is => 'ro', isa => 'Bool');
has 'league' => (metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 'l',);
has 'exam' => ( metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 'e',);
has 'session' => ( metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 's',);
has 'beancan' => ( metaclass => 'Getopt', is => 'ro', isa => 'Int',
		cmd_flag => 'n',);
has 'tables' => ( metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 'g',);


has 'round' => ( metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 'r',);

# letters2score.pl
has 'exercise' => ( metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 'x',);
has 'one' => ( metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 'o',);
has 'two' => ( metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 't',);

has 'weights' => (metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 'w',);
has 'player' => (metaclass => 'Getopt', is => 'ro', isa => 'Str',
		cmd_flag => 'p',);

package Grades;

=head1 NAME

Grades - A collocation of homework, classwork and exams

=head1 SYNOPSIS

	use Grades;

	my $script = Grades::Script->new_with_options( league => getcwd );
	my $league = League->new( id => $script->league );
	my $grades = Grades->new( league => $league );

	$league->approach->meta->apply( $grades );
	my $classworkgrades = $grades->classwork;
	my $homeworkgrades = $grades->homework;
	my $examgrades = $grades->examGrade;

=head1 DESCRIPTION

An alternative to a spreadsheet for grading students, using YAML files and scripts. The students are the players in a league ( class.) See the README and example emile league in t/emile in the distribution for the layout of the league directory in which homework, classwork and exam scores are recorded.

Grades are a collocation of Classwork, Homework and Exams roles, but the Classwork role 'delegates' its methods to one of a number of approaches, each of which has a 'total' and 'totalPercent' method. Current approaches, or forms of curriculum, include Compcomp, Groupwork and Jigsaw.

Keywords: gold stars, token economies, bean counter

=cut

=head1 ATTRIBUTES & METHODS

=cut

=head2 LEAGUE CLASS

=cut

class League {
	use YAML qw/LoadFile DumpFile/;
	use List::MoreUtils qw/any/;
	use Grades::Types qw/PlayerName PlayerNames Members/;
	use Try::Tiny;
	use Carp;

=head3 leagues

The path to the league directory.

=cut

	has 'leagues' => (is => 'ro', isa => 'Str', required => 1, lazy => 1,
	    default => '/home/drbean/022' );

=head3 id

Actually, it's a path to the league directory, below the $grades->leagues dir.

=cut

	has 'id' => (is => 'ro', isa => 'Str', required => 1);

=head3 yaml

The content of the league configuration file.

=cut

	has 'yaml' => (is => 'ro', isa => 'HashRef', lazy_build => 1);
	method _build_yaml {
			my $leaguedirs = $self->leagues;
			my $league = $self->id;
			$self->inspect( "$leaguedirs/$league/league.yaml" );
	}

=head3 name

The name of the league (class).

=cut

	has 'name' => (is => 'ro', isa => 'Str', lazy_build => 1);
	method _build_name {
		my $data = $self->yaml;
		$data->{league};
	}


=head3 field

The field of the league (class). What is the subject or description, the area of endeavor?

=cut

	has 'field' => (is => 'ro', isa => 'Str', lazy_build => 1);
	method _build_field {
		my $data = $self->yaml;
		$data->{field};
	}


=head3 approach

The style of classwork competition, eg Compcomp, or Groupwork. This is the name of the class (think OOP) to which 'classwork' and other methods are delegated.

=cut

	has 'approach' => (is => 'ro', isa => 'Str', lazy => 1,
	    default => sub { shift->yaml->{approach} } );

=head3 members

Hash refs of the players (students) in the league. The module assumes each of the members in the arrayref returned by this attribute is a hash ref containing an id and name of the member.

=cut

	has 'members', is => 'ro', isa => Members, lazy_build => 1;
	method _build_members {
		my $data = $self->yaml;
		$data->{member};
	}

=head3 session

The first week in each session, like { 1 => 1, 2 => 5, 3 => 10, 4 => 14 }, monotonically increasing week numbers.

=cut

	has 'session', (is => 'ro', isa => 'HashRef',
	    lazy => 1, default => sub { shift->yaml->{session} } );


=head3 absentees

Students who have stopped coming to class and so won't be included in classwork scoring.

=cut

	has 'absentees', (is => 'ro', isa => PlayerNames,
	    lazy => 1, default => sub { shift->yaml->{out} } );


=head3 transfer

    $oldleague = $newleague->transfer->{V9731059}

Players who have transferred to this league from some other league at some point and the leagues they transferred from.

=cut

	has 'transfer', (is => 'ro', isa => 'HashRef',
	    lazy => 1, default => sub { shift->yaml->{transfer} } );


=head3 is_member

Whether the passed id is that of a member in the league (class).

=cut

	method is_member (Str $id) {
		my $data = $self->yaml;
		any { $_->{id} eq $id } @{$data->{member}};
	}


=head3 ided

The id of the member with the given player name.

=cut

    method ided( Str $player) {
	my $members = $self->members;
	my %ids = map { $_->{id} => $_->{name} }
	    grep { $_->{name} eq $player } @$members;
	my @ids = keys %ids;
	my @names = values %ids;
	local $" = ', ';
	carp @ids . " players named @names, with ids: @ids," unless @ids==1;
	if ( @ids == 1 ) { return $ids[0] }
	else { return $ids{$player}; }
    }

=head3 inspect

Loads a YAML file.

=cut

    method inspect (Str $file) {
	my ($warning, $data);
	try { $data = LoadFile $file }
	    catch { carp "Couldn't open $file," };
	return $data;
	}

=head3 save

Dumps a YAML file

=cut

    method save (Str $file, HashRef $data) {
	try { DumpFile $file, $data }
	    catch { warn "Couldn't save $data to $file," };
	}

}


=head2	PLAYER CLASS

=cut

class Player {
	use List::MoreUtils qw/firstval/;
	use List::Util qw/sum/;
	use POSIX;

=head3 league

The league the player is in. This is required.

=cut

	has 'league' => (is => 'ro', isa => 'League', required => 1);

=head3 id

The id of the player. This is required.

=cut

	has 'id' => (is => 'ro', isa => 'Str', required => 1);

=head3 id

The name of the player.

=cut

	has 'name' => (is => 'ro', isa => 'Str', lazy_build => 1);
	method _build_name {
		my $league = $self->league;
		my $id = $self->id;
		my $members = $league->members;
		my $member = firstval { $_->{id} eq $id } @$members;
		$member->{name};
	}

	has 'Chinese' => (is => 'ro', isa => 'Str');
}


=head2 NONENTITY CLASS

=cut

class Nonentity extends Player {

=head3 name

The name is 'Bye'. The id is too, as a matter of fact.

=cut

    has 'name' => (is => 'ro', isa => 'Str', required => 1 );

}


=head2	GRADES CLASS

=head2 Grades' Homework Methods
=cut

role Homework {
	use YAML qw/LoadFile DumpFile/;
	use List::Util qw/min sum/;
	use Scalar::Util qw/looks_like_number/;
	use Carp;
    use Grades::Types qw/PlayerId HomeworkResult HomeworkRound HomeworkRounds
	RoundsResults/;

=head3 hwdir

The directory where the homework is.

=cut

    has 'hwdir' => (is => 'ro', isa => 'Str', lazy_build => 1);
    method _build_hwdir {
	my $league = $self->league->id;
	my $leaguedir = $self->league->leagues . "/" . $league;
	my $basename = shift->league->yaml->{hw} || "exams";
	my $hwdir = $leaguedir . '/' . $basename;
    }

=head3 rounds

An arrayref of the rounds for which there are homework grades for players in the league, in round order, of the form, [1, 3 .. 7, 9 ..].

=cut

	has 'rounds', (is => 'ro', isa => 'ArrayRef[Int]', lazy_build => 1);
	method _build_rounds {
		my $hwdir = $self->hwdir;
		my @hw = glob "$hwdir/*.yaml";
		[ sort {$a<=>$b} map m/^$hwdir\/(\d+)\.yaml$/, @hw ];
	}

=head3 roundIndex

Given a round name (ie number), returns the ordinal position in which this round was played, with the first round numbered 0. Returns undef if the round was not played.

=cut

	method roundIndex (Int $round) {
		my $rounds = $self->rounds;
		my $n = 0;
		for ( @$rounds ) {
			return $n if $_ eq $round;
			$n++;
		}
	}

=head3 roundfiles

An hashref of the files with data for the rounds for which there are homework grades for players in the league, keyed on rounds.

=cut

	has 'roundfiles', (is => 'ro', isa => 'HashRef[ArrayRef]', lazy_build => 1);
	method _build_roundfiles {
		my $hwdir = $self->hwdir;
		my @hw = glob "$hwdir/*.yaml";
		my @rounds = map m/^$hwdir\/(\d+)\.yaml$/, @hw;
		+{ map { $_ => [ glob "$hwdir/${_}*.yaml" ] } @rounds }
	}

=head3 hwbyround

A hashref of the homework grades for players in the league for each round.

=cut

	has 'hwbyround', (is => 'ro', isa => RoundsResults, lazy_build => 1);
	method _build_hwbyround {
		my $hwdir = $self->hwdir;
		my $rounds = $self->rounds;
		my %results =
		    map { $_ => $self->inspect("$hwdir/$_.yaml") } @$rounds;
		my %grades = map { $_ => $results{$_}{grade} } @$rounds;
		return \%grades;
	}

=head3 hwMax

The highest possible score in the homework

=cut

	has 'hwMax' => (is => 'ro', isa => 'Int', lazy => 1, default =>
					sub { shift->league->yaml->{hwMax} } );

=head3 totalMax

The total maximum points that a Player could have gotten to this point in the whole season. There may be more (or fewer) rounds played than expected, so the actual top possible score returned by totalMax may be more (or less) than the figure planned.

=cut

	has 'totalMax' => (is => 'ro', isa => 'Int', lazy_build => 1);
	method _build_totalMax {
		my $rounds = $self->rounds;
		my $hwMax = $self->hwMax;
		$hwMax * @$rounds;
	}

=head3 rawscoresinRound

Given a round, returns a hashref of the raw scores for that round, keyed on the names of the exercises. These are in files in the hwdir with names of the form ^\d+[_.]\w+\.yaml$

=cut

	method rawscoresinRound (Int $round) {
		my $hwdir = $self->hwdir;
		my $files = $self->roundfiles->{$round};
		my @ex = map m/^$hwdir\/$round([_.]\w+)\.yaml$/, @$files;
		my $results = $self->inspect("$hwdir/$round.yaml");
		return { $results->{exercise} => $results->{points} };
	}

=head3 hwforid

Given a player's id, returns an array ref of the player's hw scores.

=cut

    method hwforid( PlayerId $id) {
	my $leagueId = $self->league->id;
        my $hw       = $self->hwbyround;
        my $rounds = $self->rounds;
        my @hwbyid;
        for my $round (@$rounds) {
            unless ( $hw->{$round} ) {
                warn "No homework results in Round $round in $leagueId league";
                next;
            }
            my $grade = $hw->{$round}->{$id};
	    if ( defined $grade and looks_like_number( $grade ) ) {
                push @hwbyid, $grade;
            }
            elsif ( defined $grade and $grade =~ m/transfer/i ) {
                my $oldleagueId = $self->league->transfer->{$id};
                my $league   = League->new( id => $oldleagueId );
                my $grades   = Grades->new({ league => $league });
                my $transfergrade    = $grades->hwbyround->{$round}->{$id};
                warn
"$id transfered from $oldleagueId league but no homework there in round $round"
                  unless defined $transfergrade;
                push @hwbyid, $transfergrade || 0;
            }
            else {
	warn "No homework result for $id in Round $round in $leagueId league\n";
            }
        }
        \@hwbyid;
    }

=head3 hwforidasHash

Given a player's id, returns an hashref of the player's hw grades, keyed on the rounds.

=cut

	method hwforidasHash (PlayerId  $id) {
		my $hw = $self->hwforid( $id );
		my $rounds = $self->rounds;
		my %hwbyid;
		for my $i ( 0 .. $#$rounds ) {
			my $round = $rounds->[$i];
			$hwbyid{$round} = $hw->[$i];
			if ( not defined $hw->[$i] ) { warn
				"No homework result for $id in Round $round\n";}
		}
		\%hwbyid;
	}

=head3 homework

Running total homework scores of the league.

=cut

	method homework {
		my $league = $self->league;
		my $leagueId = $league->id;
		my $players = $league->members;
		my %players = map { $_->{id} => $_ } @$players;
		my %idtotals;
		for my $player ( keys %players ) {
		    my $homework = $self->hwforid( $player );
		    my $total = sum @$homework;
		    $idtotals{$player} = $total;
		}
		+{ map { $_ => $idtotals{$_} || 0 } keys %idtotals };
	}

=head3 homeworkPercent

Running total homework scores of the league as percentages of the totalMax to that point, with a maximum of 100.

=cut

	method homeworkPercent {
		my $league = $self->league->id;
		my $totalMax = $self->totalMax;
		my $idtotals = $self->homework;
		my %percent;
		if ( $totalMax == 0 ) {
		    $percent{$_} = 0  for keys %$idtotals;
		}
		else {
		    %percent = map {
			$_ => min( 100, 100 * $idtotals->{$_} / $totalMax )
				|| 0 } keys %$idtotals;
		}
		return \%percent;
	}
}


=head2 Grades' Jigsaw Methods

The jigsaw is a cooperative learning activity where all the players in a group get different information that together produces the 'big picture', and where they are each held responsible for the understanding of each of the other individual members of this big picture.

=cut

role Jigsaw {
    use List::MoreUtils qw/any all/;
    use Try::Tiny;
    use Moose::Autobox;

=head3 jigsawdirs

The directory where the jigsaws are.

=cut

    has 'jigsawdirs' => (is => 'ro', isa => 'Str', lazy_build => 1);
    method _build_jigsawdirs {
	my $league = $self->league->id;
	my $leaguedir = $self->league->leagues . "/" . $league;
	my $basename = shift->league->yaml->{jigsaw} || "exam";
	my $jigsawdir = $leaguedir .'/' . $basename;
	}

=head3 config

The round.yaml file with data about the jigsaw activity in the given round (directory.)

=cut

    method config( Str $round) {
	my $jigsaws = $self->jigsawdirs;
        my $config;
	try { $config = $self->inspect("$jigsaws/$round/round.yaml") }
	    catch { warn "No config file for $jigsaws/$round jigsaw" };
	return $config;
    }

=head3 topic

The topic of the quiz in the given jigsaw for the given group.

=cut

    method topic ( Str $jigsaw, Str $group ) {
	my $config = $self->config('Jigsaw', $jigsaw);
	my $activity = $config->{activity};
	for my $topic ( keys %$activity ) {
	    my $forms = $activity->{$topic};
	    for my $form ( keys %$forms ) {
		my $tables = $forms->{$form};
		return $topic if any { $_ eq $group } @$tables;
	    }
	}
	return;
}

=head3 form

The form of the quiz in the given jigsaw for the given group.

=cut

    method form ( Str $jigsaw, Str $group ) {
	my $config = $self->config('Jigsaw', $jigsaw);
	my $activity = $config->{activity};
	for my $topic ( keys %$activity ) {
	    my $forms = $activity->{$topic};
	    for my $form ( keys %$forms ) {
		my $tables = $forms->{$form};
		return $form if any { $_ eq $group } @$tables;
	    }
	}
	return;
    }

=head3 quizfile

The file system location of the file with the quiz questions and answers for the given jigsaw.

=cut

    method quizfile ( Str $jigsaw ) {
	my $config = $self->config('Jigsaw', $jigsaw);
	return $config->{text};
    }

=head3 quiz

The quiz questions (as an anon array) in the given jigsaw for the given group.

=cut

    method quiz ( Str $jigsaw, Str $group ) {
	my $quizfile = $self->quizfile($jigsaw);
	my $activity;
	try { $activity = $self->inspect( $quizfile ) }
	    catch { warn "No $quizfile jigsaw content file" };
	my $topic = $self->topic( $jigsaw, $group );
	my $form = $self->form( $jigsaw, $group );
	my $quiz = $activity->{$topic}->{jigsaw}->{$form}->{quiz};
    }

=head3 options

    $grades->options( '2/1', 'Purple', 0 ) # [ qw/Deborah Don Dovonna Sue/ ]

The options (as an anon array) to the given question in the given jigsaw for the given group.

=cut

    method options ( Str $jigsaw, Str $group, Int $question ) {
	my $quiz = $self->quiz( $jigsaw, $group );
	my $options = $quiz->[$question]->{option};
	return $options || '';
    }

=head3 qn

The number of questions in the given jigsaw for the given group.

=cut

    method qn ( Str $jigsaw, Str $group ) {
	my $quiz = $self->quiz( $jigsaw, $group );
	warn "No quiz for $group group in jigsaw $jigsaw," unless $quiz;
	return scalar @$quiz;
    }

=head3 responses

The responses of the members of the given group in the given jigsaw (as an anon hash keyed on the ids of the members). In a file in the jigsaw directory called 'response.yaml'.

=cut


    method responses ( Str $jigsaw, Str $group ) {
	my $jigsaws = $self->jigsawdirs;
	my $responses = $self->inspect( "$jigsaws/$jigsaw/response.yaml" );
	return $responses->{$group};
    }

=head3 jigsawGroups

A hash ref of all the groups in the given jigsaw and the names of members of the groups, keyed on groupnames. There may be duplicated names if one player did the activity twice as an 'assistant' for a group with not enough players, and missing names if a player did not do the quiz.

=cut

	method jigsawGroups (Str $jigsaw ) {
		my $config = $self->config('Jigsaw', $jigsaw );
		$config->{group};
	}

=head3 jigsawGroupMembers

An array (was hash ref) of the names of the members of the given group in the given jigsaw, in order of the roles, A..D.

=cut

	method jigsawGroupMembers (Str $jigsaw, Str $group) {
		my $groups = $self->jigsawGroups( $jigsaw );
		my $members = $groups->{$group};
	}

=head3 roles

At the moment, just A .. D.

=cut

	has 'roles' => (is => 'ro', isa => 'ArrayRef[Str]',
	    default => sub { [ qw/A B C D/ ] } );


=head3 idsbyRole

Ids in array, in A-D role order

=cut


    method idsbyRole ( Str $jigsaw, Str $group ) {
	my $members = $self->league->members;
	my %namedMembers = map { $_->{name} => $_ } @$members;
	my $namesbyRole = $self->jigsawGroupMembers( $jigsaw, $group );
	my @idsbyRole = map { $namedMembers{$_}->{id} } @$namesbyRole;
	return \@idsbyRole;
    }

=head3 assistants

A array ref of all the players in the (sub)jigsaw who did the the activity twice to 'assist' groups with not enough (or absent) players, or individuals with no groups, or people who arrived late.

=cut

	method assistants (Str $jigsaw) {
		my $round = $self->config( $jigsaw );
		$round->{assistants};
	}

=head3 jigsawGroupRole

An hash ref of the roles of the members of the given group in the given jigsaw, keyed on the name of the player.

=cut

	method jigsawGroupRole (Str $jigsaw, Str $group) {
		my $members = $self->jigsawGroupMembers( $jigsaw, $group );
		my %roles;
		@roles{ @$members } = $self->roles->flatten;
		return \%roles;
	}

=head3 id2jigsawGroupRole

An hash ref of the roles of the members of the given group in the given jigsaw, keyed on the id of the player.

=cut

	method id2jigsawGroupRole (Str $jigsaw, Str $group) {
		my $members = $self->jigsawGroupMembers( $jigsaw, $group );
		my @ids = map { $self->league->ided($_) } @$members;
		my $roles = $self->roles;
		my %id2role; @id2role{@ids} = @$roles;
		return \%id2role;
	}

=head3 name2jigsawGroup

An array ref of the group(s) to which the given name belonged in the given jigsaw. Normally, the array ref has only one element. But if the player was an assistant an array ref of more than one group is returned. If the player did not do the jigsaw, no groups are returned.

=cut

	method name2jigsawGroup (Str $jigsaw, Str $name) {
		my $groups = $self->jigsawGroups( $jigsaw );
		my @memberships;
		for my $id ( keys %$groups ) {
			my $group = $groups->{$id};
			push @memberships, $id if any { $_ eq $name } @$group;
		}
		return \@memberships;
	}

=head3 rawJigsawScores

The individual scores on the given quiz of each member of the given group, keyed on their roles, no, ids, from the file called 'scores.yaml' in the given jigsaw dir. If the scores in that file have a key which is a role, handle that, but, yes, the keys of the hashref returned here are the players' ids.

=cut

    method rawJigsawScores (Str $round, Str $group) {
        my $data;
	my $jigsaws = $self->jigsawdirs;
	try { $data = $self->inspect( "$jigsaws/$round/scores.yaml"); }
	    catch { warn "No scores for $group group in jigsaw $round."; };
	my $groupdata = $data->{letters}->{$group};
	my $ids       = $self->idsbyRole( $round, $group );
	my $roles     = $self->roles;
	my @keys;
	if (
	    any { my $key = $_; any { $_ eq $key } @$roles; } keys %$groupdata
	) {
	    @keys = @$roles;
	}
        else {
            @keys = grep { my $id = $_; any { $_ eq $id } @$ids }
		    keys %$groupdata;
        }
        my %scores;
	@scores{@keys} = @{$groupdata}{@keys};
	return \%scores;
    }

=head3 chinese

The number of times Chinese was used in the given round by all the groups. If there is no record of Chinese use, returns values of 0.

=cut

    method chinese (Str $round) {
        my $data;
	my $jigsaws = $self->jigsawdirs;
	try { $data = $self->inspect( "$jigsaws/$round/scores.yaml"); }
	    catch { warn "No scores in jigsaw $round."; };
	my $chinese = $data->{Chinese};
	my $groups = $self->jigsawGroups( $round );
	$chinese->{ $_ } ||= 0 for keys %$groups;
	return $chinese;
    }

=head3 jigsawDeduction

Points deducted for undesirable performance elements (ie Chinese use) on the quiz of the given group in the given exam.

=cut

    method jigsawDeduction (Str $jigsaw, Str $group) {
	my $data;
	my $jigsaws = $self->jigsawdirs;
	try { $data = $self->inspect( "$jigsaws/$jigsaw/scores.yaml" ); }
	    catch { warn
		"Deductions for $group group in $jigsaw jigsaw?" };
	my $demerits = $data->{Chinese}->{$group};
	return $demerits;
    }

}


=head2 Grades' Classwork Methods

Classwork is work done in class with everyone and the teacher present. Two classwork approaches are Compcomp and Groupwork. Others are possible. Depending on the league's approach accessor, the methods are delegated to the appropriate Approach object.

=cut

class Classwork {
	use Grades::Types qw/Results/;

=head3 approach

Delegatee handling classwork_total, classworkPercent

=cut

    has 'approach' => ( is => 'ro', isa => 'Approach', required => 1,
	    handles => [ qw/
		series beancans
		all_events points
		classwork_total classworkPercent / ] );

}

=head2 Classwork Approach

Handles Classwork's classwork_total and classworkPercent methods. Calls the total or totalPercent methods of the class whose name is in the 'type' accessor.

=cut

class Approach {

=head3 league

The league (object) whose approach this is.

=cut

    has 'league' => (is =>'ro', isa => 'League', required => 1,
				handles => [ 'inspect' ] );

=head3 groupworkdirs

The directory under which there are subdirectories containing data for the group/pair-work sessions. Look first in 'groupwork', then 'compcomp' mappings, else use 'classwork' dir.

=cut

    has 'groupworkdirs' => (is => 'ro', isa => 'Str', lazy_build => 1);
    method _build_groupworkdirs {
	my $league = $self->league;
	my $id = $league->id;
	my $leaguedir = $self->league->leagues . "/" . $id;
	my $basename = $league->yaml->{groupwork} ||
			$league->yaml->{compcomp} || "classwork";
	my $groupworkdirs = $leaguedir .'/' . $basename;
	}

=head3 series

The sessions (weeks) over the series (semester) in each of which there was a different grouping and results of players. This method returns an arrayref of the names (numbers) of the sessions, in numerical order, of the form, [1, 3 .. 7, 9, 10 .. 99 ]. Results are in sub directories of the same name, under groupworkdirs.

=cut

    has 'series' =>
      ( is => 'ro', isa => 'Maybe[ArrayRef[Int]]', lazy_build => 1 );
    method _build_series {
        my $dir = $self->groupworkdirs;
        my @subdirs = grep { -d } glob "$dir/*";
        [ sort { $a <=> $b } map m/^$dir\/(\d+)$/, @subdirs ];
    }

#=head3 all_events
#
#All the weeks, or sessions or lessons for which grade data is being assembled from for the grade component.
#
#=cut
#
#    method all_events {
#	my $league = $self->league;
#	my $type = $league->approach;
#	my $meta = $type->meta;
#	my $total = $type->new( league => $league )->all_events;
#    }
#
#=head3 points
#
#Week-by-weeks, or session scores for the individual players in the league.
#
#=cut
#
#    method points (Str $week) {
#	my $league = $self->league;
#	my $type = $league->approach;
#	my $meta = $type->meta;
#	my $total = $type->new( league => $league )->points( $week );
#    }
#
#=head3 classwork_total
#
#Calls the pluginned approach's classwork_total.
#
#=cut
#
#    method classwork_total {
#	my $league = $self->league;
#	my $type = $league->approach;
#	my $total = $type->new( league => $league )->total;
#    }
#
=head3 classworkPercent

Calls the pluginned approach's classworkPercent.

=cut

    method classworkPercent {
	my $league = $self->league;
	my $type = $league->approach;
	my $total = $type->new( league => $league )->totalPercent;
    }
}


=head2 Grades' Compcomp Methods

The comprehension question competition is a Swiss tournament regulated 2-partner conversation competition where players try to understand more of their opponent's information than their partners understand of theirs.

=cut

class Compcomp extends Approach {
    use Try::Tiny;
    use Moose::Autobox;
    use List::Util qw/max min/;
    use List::MoreUtils qw/any all/;
    use Carp qw/carp/;
    use Grades::Types qw/Results/;

=head3 compcompdirs

The directory under which there are subdirectories containing data for the Compcomp rounds.

=cut

    has 'compcompdirs' => (is => 'ro', isa => 'Str', lazy_build => 1 );
    method _build_compcompdirs {
	my $leaguedir = $self->league->leagues . "/" . $self->league->id;
	my $compcompdir = $leaguedir .'/' . shift->league->yaml->{compcomp};
    }

=head3 all_events

The pair conversations over the series (semester). This method returns an arrayref of the numbers of the conversations, in numerical order, of the form, [1, 3 .. 7, 9, 10 .. 99 ]. Results are in sub directories of the same name, under compcompdirs.

=cut

    has 'all_events' =>
      ( is => 'ro', isa => 'Maybe[ArrayRef[Int]]', lazy_build => 1 );
    method _build_all_events {
        my $dir = $self->compcompdirs;
        my @subdirs = grep { -d } glob "$dir/*";
        [ sort { $a <=> $b } map m/^$dir\/(\d+)$/, @subdirs ];
    }

=head3 config

The round.yaml file with data about the Compcomp activity for the given conversation (directory.)

=cut

    method config( Str $round) {
	my $comp = $self->compcompdirs;
	my $file = "$comp/$round/round.yaml";
        my $config;
	try { $config = $self->inspect($file) }
	    catch { warn "No config file for Compcomp round $round at $file" };
	return $config;
    }

=head3 activities

The activities which individual tables did in the given round. Keys are topics, keyed are forms. These, in turn, are keys of tables doing those topics and those forms.

=cut

    method activities( Str $round ) {
	my $config = $self->config( $round );
	return $config->{activity};
    }

=head3 tables

The tables with players according to their roles for the given round, as an hash ref. In the 'group' or 'activities' mapping in the config file. Make sure each table has a unique table number. Some code here is same as in Swiss's round_table.pl and dblineup.rc.

activities:
  drbean:
    1:
      - U9931007
      - U9933022
  novak:
    1:
      - U9931028
      - U9933045

=cut

    method tables ( Str $round ) {
	my $config = $self->config($round);
	my (@pairs, %pairs, @dupes, $wantlist);
	my $groups = $config->{group};
	return $groups if $groups;
	my $activities = $config->{activity};
	for my $key ( keys %$activities ) {
	    my $topic = $activities->{$key};
	    for my $form ( keys %$topic ) {
		my $pairs = $topic->{$form};
		if ( ref( $pairs ) eq 'ARRAY' ) {
		    $wantlist = 1;
		    for my $pair ( @$pairs ) {
		    my @players = values %$pair;
		    my @roles = keys %$pair;
		    push @pairs, $pair unless
			any { my @previous = values %$_;
			    any { my $player=$_;
				any { $player eq $_ } @previous
			    } @players
			} @pairs;
		    }
		}
		else {
		    for my $n ( keys %$pairs ) {
			my $pair = $pairs->{$n};
			my @twoplayers = values %$pair;
			die "Table number $n with players @twoplayers is dupe" if
			    exists $pairs{$n} or
			    any { my $player = $_; any { $player eq $_ } @dupes
				} @twoplayers;
			push @dupes, @twoplayers;
			$pairs{ $n } = $pair;
		    }
		}
	    }
	}
	return \@pairs if $wantlist;
	return \%pairs;
    }

=head3 pair2table

A player and opponent mapped to a table number.

=cut

    method pair2table ( Str $player, Str $opponent, Str $round ) {
	my $table = $self->tables( $round );
	for my $n ( keys %$table ) {
	    my $table = $table->{$n};
	    my @pair = values %$table;
	    if ( any { $_ eq $player } @pair ) {
		if ( any { $_ eq $opponent } @pair ) {
		    return { $n => $table };
		}
	    }
	}
	die "No table with player $player, opponent $opponent in round $round";
    }

=head3 compQuizfile

The file system location of the file with the quiz questions and answers for the given Compcomp activity.

=cut

    method compQuizfile ( Str $round ) {
	my $config = $self->config($round);
	my $text = $config->{text};
	return $self->compcompdirs . "/../" . $text;
    }

=head3 topicNames

Returns the names of comp quiz topics as an arrayref.

=cut

    method topicNames ( Str $round ) {
	my $config = $self->config($round);
	my $activities = $config->{activity};
	my @topics = keys %$activities;
	return \@topics;
    }

=head3 compQuizAttempted

Returns the comp quiz topics and their associated forms attempted by the given group in the round, as an arrayref of hashrefs keyed on 'topic' and 'form'.

=cut

    method compQuizAttempted ( Str $round, Str $table ) {
	my $config = $self->config($round);
	my $activities = $config->{activity};
	my $selection = $self->compQuizSelection;
	my $attempted;
	for my $topic ( keys %$selection ) {
	    my $forms = $selection->{$topic};
	    for my $form ( keys %$forms ) {
		my $tables = $activities->{$topic}->{$form};
		push @$attempted, { topic => $topic, form => $form }
		    if any { $table == $_ } @$tables;
	    }
	}
	return $attempted;
    }

=head3 compQuiz

The compQuiz questions (as an anon array) in the given Compcomp activity for the given table.

=cut

    method compQuiz ( Str $round, Str $table ) {
	my $quizfile = $self->compQuizfile($round);
	my $activity;
	try { $activity = $self->inspect( $quizfile ) }
	    catch { warn "No $quizfile Compcomp content file" };
	my $topic = $self->compTopic( $round, $table );
	my $form = $self->compForm( $round, $table );
	my $quiz = $activity->{$topic}->{compcomp}->{$form}->{quiz};
	carp "No $topic, $form quiz in $quizfile," unless $quiz;
	return $quiz;
    }

=head3 compTopic

The topic of the quiz in the given Compcomp round for the given table. Each table has one and only one quiz.

=cut

    method compTopic ( Str $round, Str $table ) {
	my $config = $self->config($round);
	my $activity = $config->{activity};
	for my $topic ( keys %$activity ) {
	    my $forms = $activity->{$topic};
	    for my $form ( keys %$forms ) {
		my $tables = $forms->{$form};
		return $topic if any { $_ eq $table } @$tables;
	    }
	}
	carp "Topic? No quiz at table $table in round $round,";
	return;
    }

=head3 compTopics

The topics of the quiz in the given Compcomp round for the given table, as an array ref.

=cut

    method compTopics ( Str $round, Str $table ) {
	my $config = $self->config($round);
	my $activity = $config->{activity};
	my %topics;
	for my $topic ( keys %$activity ) {
	    my $forms = $activity->{$topic};
	    for my $form ( keys %$forms ) {
		my $tables = $forms->{$form};
		$topics{ $topic } += 1 if any { $_ eq $table } @$tables;
	    }
	}
	carp "Topic? No quiz at table $table in round $round," unless %topics;
	my @topics = keys %topics;
	return \@topics;
    }

=head3 compForm

The form of the quiz in the given Compcomp round for the given table. Each table has one and only one quiz.

=cut

    method compForm ( Str $round, Str $table ) {
	my $config = $self->config($round);
	my $activity = $config->{activity};
	for my $topic ( keys %$activity ) {
	    my $forms = $activity->{$topic};
	    for my $form ( keys %$forms ) {
		my $tables = $forms->{$form};
		return $form if any { $_ eq $table } @$tables;
	    }
	}
	carp "Form? No quiz at table $table in round $round,";
	return;
    }

=head3 compForms

The forms in the given Compcomp round for the given table, in the given quiz (topic), as an array ref.

=cut

    method compForms ( Str $round, Str $table, Str $topic ) {
	my $config = $self->config($round);
	my $activity = $config->{activity};
	my $forms = $activity->{$topic};
	my @forms;
	for my $form ( keys %$forms ) {
	    my $tables = $forms->{$form};
	    push @forms, $form if any { $_ eq $table } @$tables;
	}
	carp "Form? No quiz at table $table in round $round," unless @forms;
	return \@forms;
    }

=head3 compqn

The number of questions in the given Compcomp quiz for the given pair.

=cut

    method compqn ( Str $round, Str $table ) {
	my $quiz = $self->compQuiz( $round, $table );
	return scalar @$quiz;
    }

=head3 idsbyCompRole

Ids in array, in White, Black role order

=cut


    method idsbyCompRole ( Str $round, Str $table ) {
	my $members = $self->league->members;
	my %namedMembers = map { $_->{name} => $_ } @$members;
	my $config = $self->config( $round );
	my $pair = $config->{group}->{$table};
	my @idsbyRole = @$pair{qw/White Black/};
	return \@idsbyRole;
    }

=head3 scores

The scores at the tables of the tournament in the given round (as an anon hash keyed on the ids of the members). In a file in the Compcomp round directory called 'result.yaml'.

=cut


    method scores ( Str $round ) {
	my $comp = $self->compcompdirs;
	my $file = "$comp/$round/scores.yaml";
	my $results = $self->inspect( $file );
	return $results;
    }

=head3 compResponses

The responses of the members of the given pair in the given round (as an anon hash keyed on the ids of the members). In a file in the Compcomp round directory called 'response.yaml'.

=cut


    method compResponses ( Str $round, Str $table ) {
	my $comp = $self->compcompdirs;
	my $file = "$comp/$round/response.yaml";
	my $responses = $self->inspect( $file );
	return { free => $responses->{free}->{$table},
		 set => $responses->{set}->{$table} };
    }

=head3 freeTotals

The number of free questions each asked by White and Black.

=cut


    method freeTotals ( Str $round, Str $table ) {
	my $response = $self->compResponses( $round, $table );
	my $player = $self->idsbyCompRole( $round, $table );
	my $topics = $self->compTopics( $round, $table );
	my @qn = (0,0);
	for my $topic ( @$topics ) {
	    my $forms = $self->compForms( $round, $table, $topic );
	    for my $form ( @$forms ) {
		for my $n ( 0,1 ) {
		    my $points =
			$response->{free}->{$topic}->{$form}->{$player->[$n]}->{point};
		    $qn[$n] += max ( grep { $points->{$_} ne 'Nil' }
				    keys %$points ) || 0;
		}
	    }
	}
	return \@qn;
    }

=head3 lowerFreeTotal

The lesser of the 2 numbers of free questions asked by either White and Black.

=cut

    method lowerFreeTotal ( Str $round, Str $table ) {
	my $totals = $self->freeTotals( $round, $table );
	return min @$totals;
    }

=head3 byer

The id of the player with the Bye, or the empty string.

=cut

    method byer ( Str $round ) {
	my $config = $self->config( $round );
	my $byer = $config->{bye};
	return $byer if $byer;
	return '';
    }


=head3 transfer

An array ref of the ids of the players who were playing in another league in the round, or the empty string.

=cut

    method transfer ( Str $round ) {
	my $config = $self->config( $round );
	my $transfers = $config->{transfer} || '';
	return $transfers;
    }


=head3 opponents

The ids of opponents of the players in the given conversation.

=cut

    method opponents ( Str $round ) {
	my $tables = $self->tables( $round );
	my %opponent;
	for my $n ( keys %$tables ) {
	    $opponent{$tables->{$n}->{White}} = $tables->{$n}->{Black};
	    $opponent{$tables->{$n}->{Black}} = $tables->{$n}->{White};
	}
	my $byer = $self->byer( $round );
	$opponent{ $byer } = 'bye' if $byer;
	my $transfers = $self->transfer( $round );
	@opponent{ @$transfers } = ( 'transfer' ) x @$transfers
	   if ( $transfers and ref( $transfers ) eq 'ARRAY' );
	my $league = $self->league;
	my $members = $league->members;
	$opponent{$_->{id}} ||= 'unpaired' for @$members;
	return \%opponent;
    }


=head3 correct

The number of questions correct in the given conversation.

=cut

    method correct ( Str $round ) {
	my $comp = $self->compcompdirs;
	my $file = "$comp/$round/scores.yaml";
	my $tables = $self->inspect( $file );
	my %correct;
	for my $table ( keys %$tables ) {
	    my $scores = $tables->{$table};
	    @correct{keys %$scores} = values %$scores;
	}
	return \%correct;
    }


=head3 assistantPoints

Assistants points are from config->{assistant} of form { Black => { U9933002 => 3, U9933007 => 4}, Yellow => { U9931007 => 4, U9933022 => 4 } }, and are the points for examiners with other responsibilities who are not participating in the round.

=cut

    method assistantPoints ( Str $round ) {
	my $config = $self->config( $round );
	my $assistants = $config->{assistant};
	if ( $assistants ) {
	    my %assistantPoints = map { %{ $assistants->{$_} } } keys %$assistants;
	     # my %assistantPoints = map { $assistants->{$_}->flatten } keys %$assistants;
	     die "@{ [keys %$assistants] }: assistant member mistakes." if any
		{ not $self->league->is_member($_) } keys %assistantPoints;
	    return \%assistantPoints;
	}
    }

=head3 dispensation

Dispensation points are from config->{dispensation} of same form as assistantPoints, { Black => { U9933002 => 3, U9933007 => 4}, Yellow => { U9931007 => 4, U9933022 => 4 } }.

=cut

    method dispensation ( Str $round ) {
	my $config = $self->config( $round );
	my $dispensation = $config->{dispensation};
	if ( $dispensation ) {
	    my %dispensation = map { %{ $dispensation->{$_} } } keys %$dispensation;
	     # my %assistantPoints = map { $assistants->{$_}->flatten } keys %$assistants;
	     die "@{ [keys %$dispensation] }: members?" if any
		{ not $self->league->is_member($_) } keys %dispensation;
	    return \%dispensation;
	}
    }

=head3 payout

If payprotocol field is 'meritPay', 1 question each: 0,1 or 2 pts. 2 question each: 1,2 or 3 pts. 3 question each: 2,3 or 4 pts. 4 question each: 3,4 or 5 pts.

If the 'meritPay' payprotocol field ends in a number the specified number of questions each is required for the maximum points.
=cut

    method payout ( Str $player, Str $opponent, Str $round ) {
	my $protocol = $self->config($round)->{payprotocol};
	my ($loss, $draw, $win) = (3,4,5);
	if ( defined $protocol and $protocol =~ m/^meritPay/ ) {
	    (my $top_number = $protocol ) =~ s/^\D*(\d*)$/$1/;
	    my $required = $top_number? $top_number: 4;
	    my $table = $self->pair2table( $player, $opponent, $round );
	    my $tableN = (keys %$table)[0];
	    my $questionN = $self->lowerFreeTotal( $round, $tableN );
	    my $unfulfilled = $required - $questionN;
	    if ( $unfulfilled > 0 ) {
		$_ -= $unfulfilled for ($loss, $draw, $win);
		if ( $loss < 0 ) {
		    $loss = 0; $draw = 0; $win = 1;
		}
	    }
	}
	return { loss => $loss, draw => $draw, win => $win };
    }


=head3 points

The points of the players in the given conversation. 5 for a Bye, 1 for Late, 0 for Unpaired, 1 for a non-numerical number correct result, 5 for more correct, 3 for less correct, 4 for the same number correct. Transfers' results are computed from their results in the same round in their old league. Assistants points are from round.yaml, points for non-paired helpers.

=cut

    method points ( Str $round ) {
	my $config = $self->config( $round );
	my $opponents = $self->opponents( $round );
	my $correct = $self->correct( $round );
	my $points;
	my $late; $late = $config->{late} if exists $config->{late};
	my $forfeit; $forfeit = $config->{forfeit} if exists $config->{forfeit};
	my $assists = $self->assistantPoints( $round );
	my $dispensed = $self->dispensation( $round );
	my $byer = $self->byer( $round );
	PLAYER: for my $player ( keys %$opponents ) {
	    if ( defined $assists and any { $_ eq $player } keys %$assists){
		$points->{$player} = $assists->{$player};
		next PLAYER;
	    }
	    if ( defined $dispensed and any { $_ eq $player } keys %$dispensed){
		$points->{$player} = $dispensed->{$player};
		next PLAYER;
	    }
	    if ( any { defined } @$forfeit and any { $_ eq $player } @$forfeit){
		$points->{$player} = 0;
		next PLAYER;
	    }
	    if ( any { defined } @$late and any { $_ eq $player } @$late ) {
		$points->{$player} = 1;
		next PLAYER;
	    }
	    if ( $byer and $player eq $byer ) {
		$points->{$player} = 5;
		next PLAYER;
	    }
	    if ( $opponents->{$player} =~ m/unpaired/i ) {
		$points->{$player} = 0;
		next PLAYER;
	    }
	    if ( $opponents->{$player} =~ m/transfer/i ) {
		my $oldleagueId = $self->league->transfer->{$player};
		my $oldleague = League->new( id => $oldleagueId );
		my $oldgrades = Grades->new({ league => $oldleague });
		my $oldclasswork = $oldgrades->classwork;
		$points->{$player} = $oldclasswork->points($round)->{$player};
		next PLAYER;
	    }
	    my $other = $opponents->{$player};
	    my $alterego = $opponents->{$other};
	    die
"${player}'s opponent is $other, but ${other}'s opponent is $alterego"
		unless $other and $alterego and $player eq $alterego;
	    die "No $player quiz card in round $round?" unless exists
		$correct->{$player};
	    my $ourcorrect = $correct->{$player};
	    die "No $other card against $player in round $round?" unless
		exists $correct->{$other};
	    my $theircorrect = $correct->{$other};
	    if ( not defined $ourcorrect ) {
		$points->{$player} = 0;
		next PLAYER;
	    }
	    if ( $correct->{$player} !~ m/^\d+$/ ) {
		$points->{$player} = 1;
		next PLAYER;
	    }
	    if ( any { defined } @$forfeit and any { $_ eq $other } @$forfeit) {
		$points->{$player} = 5;
		next PLAYER;
	    }
	    my $grade = $self->payout( $player, $other, $round );
	    $points->{$player} = $ourcorrect > $theircorrect? $grade->{win}:
		$ourcorrect < $theircorrect? $grade->{loss}: $grade->{draw};
	}
	return $points;
    }


=head3 total

The total over the conversations over the series.

=cut

    has 'total' => ( is => 'ro', isa => Results, lazy_build => 1 );
    method _build_total {
	my $rounds = $self->all_events;
	my $members = $self->league->members;
	my @ids = map { $_->{id} } @$members;
	my $totals;
	@$totals{ @ids } = (0) x @ids;
	for my $round ( @$rounds ) {
	    my $points = $self->points( $round );
	    for my $id ( @ids ) {
		    next unless defined $points->{$id};
		$totals->{$id} += $points->{$id};
	    }
	}
	return $totals;
    }


=head3 totalPercent

The total over the conversations over the series expressed as a percentage of the possible score. The average should be 80 percent if every player participates in every comp.

=cut

    has 'totalPercent' => ( is => 'ro', isa => Results, lazy_build => 1 );
    method _build_totalPercent {
	my $rounds = $self->all_events;
	my $n = scalar @$rounds;
	my $totals = $self->total;
	my %percentages = $n?
	    map { $_ => $totals->{$_} * 100 / (5*$n) } keys %$totals:
	    map { $_ => 0 } keys %$totals;
	return \%percentages;
    }

}


=head2 Grades' Exams Methods
=cut

role Exams {
	use List::Util qw/max sum/;
	use List::MoreUtils qw/any all/;
	use Carp;
	use Grades::Types qw/Exam/;

=head3 examdirs

The directory where the exams are.

=cut

    has 'examdirs' => (is => 'ro', isa => 'Str', lazy_build => 1);
    method _build_examdirs {
	my $league = $self->league->id;
	my $leaguedir = $self->league->leagues . "/" . $league;
	my $basename = $self->league->yaml->{jigsaw} ||
			$self->league->yaml->{exams} || "exams";
	my $examdirs = $leaguedir .'/' . $basename;
    }

=head3 examids

An arrayref of the ids of the exams for which there are grades for players in the league, in numerical order, of the form, [1, 3 .. 7, 9, 10 .. 99 ]. Results are in sub directories of the same name, under examdir.

=cut

    has 'examids',
      ( is => 'ro', isa => 'Maybe[ArrayRef[Int]]', lazy_build => 1 );
    method _build_examids {
        my $examdirs = $self->examdirs;
        my @exams   = grep { -d } glob "$examdirs/[0-9] $examdirs/[1-9][0-9]";
        [ sort { $a <=> $b } map m/^$examdirs\/(\d+)$/, @exams ];
    }

=head3 examrounds

The rounds over which the given exam was conducted. Should be an array ref. If there were no rounds, ie the exam was conducted in one round, a null anonymous array is returned. The results for the rounds are in sub directories underneath the 'examid' directory named, in numerical order, 1 .. 99.

=cut

    method examrounds( Str $exam ) {
	my $examdirs = $self->examdirs;
        my $examids = $self->examids;
        carp "No exam $exam in exams @$examids"
	    unless any { $_ eq $exam } @$examids;
        my @rounds = glob "$examdirs/$exam/[0-9] $examdirs/$exam/[0-9][0-9]";
        [ sort { $a <=> $b } map m/^$examdirs\/$exam\/(\d+)$/, @rounds ];
      }

=head3 examMax

The maximum score possible in each individual exam. That is, what the exam is out of.

=cut

	has 'examMax' => (is => 'ro', isa => 'Int', lazy => 1, required => 1,
			default => sub { shift->league->yaml->{examMax} } );

=head3 exam

    $grades->exam($id)

The scores of the players on an individual (round of an) exam (in a 'g.yaml file in the $id subdir of the league dir.

=cut

	method exam ( Str $id ) {
	    my $examdirs = $self->examdirs;
	    my $exam = $self->inspect( "$examdirs/$id/g.yaml" );
	    if ( is_Exam($exam) ) {
		return $exam ;
	    }
	    else {
		croak
"Exam $id probably has undefined or non-numeric Exam scores, or possibly illegal PlayerIds." ;
	    }
	}

=head3 examResults

A hash ref of the ids of the players and arrays of their results over the exam series, ie examids, in files named 'g.yaml', TODO but only if such a file exists in all examdirs. Otherwise, calculate from raw 'response.yaml' files. Croak if any result is larger than examMax.

=cut

    has 'examResults' => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );
    method _build_examResults {
        my $examids = $self->examids;
	my $members = $self->league->members;
	my @playerids = map { $_->{id} } @$members;
	my %results;
	for my $id  ( @$examids ) {
	    my $exam    = $self->exam( $id );
	    my $max      = $self->examMax;
	    for my $playerid ( @playerids ) {
		my $result = $exam->{$playerid};
		carp "No exam $id results for $playerid,"
		  unless defined $result;
		croak "${playerid}'s $result greater than exam max, $max"
		  if defined $result and $result > $max;
		my $results = $results{$playerid};
		push @$results, $result;
		$results{$playerid} = $results;
	    }
	}
	return \%results;
    }

=head3 examResultHash

A hash ref of the ids of the players and hashrefs of their results for each exam. Croak if any result is larger than examMax.

=cut

	has 'examResultHash' => (is => 'ro', isa => 'HashRef', lazy_build => 1);
	method _build_examResultHash {
		my $examids = $self->examids;
		my $examResults = $self->examResults;
		my %examResults;
		for my $id ( keys %$examResults ) {
			my $results = $examResults->{$id};
			my %results;
			@results{@$examids} = @$results;
			$examResults{$id} = \%results;
		}
		return \%examResults;
	}

=head3 examResultsasPercent

A hashref of the ids of the players and arrays of their results over the exams expressed as percentages of the maximum possible score for the exams.

=cut

	has 'examResultsasPercent' => (is=>'ro', isa=>'HashRef', lazy_build=>1);
	method _build_examResultsasPercent {
		my $scores = $self->examResults;
		my @ids = keys %$scores;
		my $max = $self->examMax;
		my %percent =  map { my $id = $_; my $myscores = $scores->{$id};
		    $id => [ map { ($_||0) * (100/$max) } @$myscores ] } @ids;
		return \%percent;
	}

=head3 examGrade

A hash ref of the ids of the players and their total scores on exams.

=cut

	has 'examGrade' => (is => 'ro', isa => 'HashRef', lazy_build => 1);
	method _build_examGrade {
		my $grades = $self->examResults;
		+{ map { my $numbers=$grades->{$_};
			$_ => sum(@$numbers) }
					keys %$grades };
	}

=head3 examPercent

A hash ref of the ids of the players and their total score on exams, expressed as a percentage of the possible exam score. This is the average of their exam scores.

=cut

    has 'examPercent' => (is => 'ro', isa => 'HashRef', lazy_build => 1);
    method _build_examPercent {
	my $grades = $self->examResultsasPercent;
	my %totals = map {
		my $numbers=$grades->{$_};
		$_ => sum(@$numbers)/@{$numbers} } keys %$grades;
	return \%totals;
    }

}


=head2 Grades' Core Methods

=cut

class Grades with Homework with Exams with Jigsaw

{
#    with 'Jigsaw'
#	=> { -alias => { config => 'jigsaw_config' }, -excludes => 'config' };
    require Grades::Groupwork;
    use Carp;
    use Grades::Types qw/Weights/;

=head3 BUILDARGS

Have Moose find out the classwork approach the league has adopted and create an object of that approach for the classwork accessor. This is preferable to requiring the user to create the object and pass it at construction time.

=cut

    around BUILDARGS (ClassName $class: HashRef $args) {
        my $league = $args->{league} or die "$args->{league} league?";
        my $approach = $league->approach or die "approach?";
        my $classwork = $approach->new( league => $league ) or die "classwork?";
        $args->{classwork} = $classwork;
        return $class->$orig({ league => $league, classwork => $classwork });
    }
    # around BUILDARGS(@args) { $self->$orig(@args) }

=head3 classwork

An accessor for the object that handles classwork methods. Required at construction time.

=cut

	has 'classwork' => ( is => 'ro', isa => 'Approach', required => 1,
		handles => [ 'series', 'beancans',
			    'points', 'all_events',
		    'classwork_total', 'classworkPercent' ] );

=head3 config

The possible grades config files. Including Jigsaw, Compcomp.

=cut

	method config ( $role, $round ) {
	    my $config = "${role}::config"; $self->$config( $round );
	}

=head3 league

The league (object) whose grades these are.

=cut

	has 'league' => (is =>'ro', isa => 'League', required => 1,
				handles => [ 'inspect' ] );

=head3 weights

An hash ref of the weights (expressed as a percentage) accorded to the three components, classwork, homework, and exams in the final grade.

=cut

	has 'weights' => (is => 'ro', isa => Weights, lazy_build => 1 );
	method _build_weights { my $weights = $self->league->yaml->{weights}; }


=head3 sprintround

sprintf( '%.0f', $number). sprintf warns if $number is undef.

=cut

	method sprintround (Maybe[Num] $number) {
		sprintf '%.0f', $number;
	}

=head3 grades

A hashref of student ids and final grades.

=cut

	method grades {
		my $league = $self->league;
		my $members = $league->members;
		my $homework = $self->homeworkPercent;
		my $classcomponent = $league->approach;
		my $classwork = $self->classworkPercent;
		my $exams = $self->examPercent;
		my @ids = map { $_->{id} } @$members;
		my $weights = $self->weights;
		my %grades = map { $_ => $self->sprintround(
			$classwork->{$_} * $weights->{classwork} /100 +
			$homework->{$_} * $weights->{homework} /100 +
			$exams->{$_}    * $weights->{exams} /100 )
				} @ids;
		\%grades;
	}

}

no Moose;

__PACKAGE__->meta->make_immutable;

1;    # End of Grades

=head1 AUTHOR

Dr Bean, C<< <drbean, followed by the at mark (@), cpan, then a dot, and finally, org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-grades at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Grades>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Grades

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Grades>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Grades>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Grades>

=item * Search CPAN

L<http://search.cpan.org/dist/Grades>

=back

=head1 COPYRIGHT & LICENSE

Copyright 2009 Dr Bean, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut


# vim: set ts=8 sts=4 sw=4 noet:
__END__