sub gradeTest {
     my $answer, $runningTotal;
     $runningTotal = 0;
     $answer = lc(param(ans1));
     # For answer 1, G6-G9 is full credit.  
     # G0-G5 and K0-K5 are half credit
     $runningTotal += 1, return if $answer =~ /^g[6-9]$/;
     $runningTotal += .5, return if $answer =~ /^g[0-5]$/;
     $runningTotal += .5, return if $answer =~ /^k[0-5]$/;
}
[download]

Why not put your last two cases together?

$runningTotal += .5, return if $answer =~ /^[gk][0-5]$/;

# instead of
$runningTotal += .5, return if $answer =~ /^g[0-5]$/;
$runningTotal += .5, return if $answer =~ /^k[0-5]$/;
[download]

-- Hofmator

my %dispatch = (
     g6 => \&add_one,
     g7 => \&add_one,
     g8 => \&add_one,
     g9 => \&add_one,
     g0 => \&add_half,
     g1 => \&add_half,
     g2 => \&add_half,
     g3 => \&add_half,
     g4 => \&add_half,
     g5 => \&add_half,
     k0 => \&add_half,
     k1 => \&add_half,
     k2 => \&add_half,
     k3 => \&add_half,
     k4 => \&add_half,
     k5 => \&add_half,
);

sub add_one {
    my $total = shift;
    $total += 1;
    return $total;
}

sub add_half {
    my $total = shift;
    $total += 1;
    return $total;
}
[download]

my $total = 10;
$total    = $dispatch{'g6'}->($total);
$total    = $dispatch{'k5'}->($total);

print $total, "\n";
[download]

----------------------------------------------------
 perl -le '$x="jeff";$x++ for(0..4482550);print $x'
----------------------------------------------------

You are describing the general concept of a 'Dispatch Table'. While very useful at times I think that's a little overkill here. Your subroutines do exactly the same thing - add a number - and only this number differs. So why not just store the number as proposed by VSarkiss. Your code would then simplify to

my %lookup = ( # no longer a dispatch
   g6 => 1,
   g7 => 1,
   g8 => 1,
   g9 => 1,
   g0 => 0.5,
# ...
   );

my $total = 10;
$total += exists($lookup{'g6'})? $lookup{'g6'} : 0;

print $total, "\n";
[download]

I think I still prefer the regex solution by enoch in this easy case where the keys/answers are so 'handy' to match.

-- Hofmator

Very nice!

How about generating the table with Perl instead of a text editor? I'll just borrow the regexes you and enoch provided, if you don't mind :D

my %lookup;

foreach my $alpha ('a'..'k') {
   foreach my $numb (0..9) {
      $_ = $alpha . $numb;
      $lookup{$_} = /^g[6-9]$/ ? 1 : /^[gk][0-5]$/ ? .5 : 0;
   }
}
[download]

however, this is not very efficient if your memory is tied behind your back. ;)

----------------------------------------------------
 perl -le '$x="jeff";$x++ for(0..4482550);print $x'
----------------------------------------------------

The easiest code I can think of is to map the designation to a scalar, and then use ordinary numeric ranges to compare.

$answer =~ tr/OBAFGKM/1234567/;
if ($answer >= 56 && $answer <= 59) ...
[download]

Now, you have a lot of the same code but just changing the ranges. Make it into a table, like so:

@results= ( undef, #index 0 unused
  [ #describe question 1
     qw/ g0 k5   g6 g9/ ],
   # another row for each question.
[download]

—John

I'm in the "make a hash table" camp. You're going to need to sit down and type the right answers per question, which are relatively arbitrary, so make data entry easy:

my $credit = [
    {
        (map {$_ => 1.0} qw(g6 g7 g8 g9)),
        (map {$_ => 0.5} qw(g0 g1 g2 g3 g4 g5
                            k0 k1 k2 k3 k4 k5)),
    },
];
[download]

if (exists $credit->[$qnum]{$answer})
{
    print "Q $qnum: ", $credit->[$qnum]{$answer}, " points\n";
}
else
{
    print "wrong\n";
}
[download]

HTH

use strict;

sub rank {
 local $_ = shift;
 tr/OBAFGKM/1-7/;
 $_;
}

# Enter questions and scores and answers
# Enter answers as a range of values.
my %scores = (
 1 => { 1   => { O9=>'B1',
                 K1=>'K2',
               },
        0.5 => { B4=>'B5',
                 B7=>'B7',
               },
      },
 2 => { 1   => { K8=>'K9',
               },
        0.5 => { F1=>'F2',
               },
      },
);

my %ranges;
for my $question (keys %scores) {
  my $scores = $scores{$question};
  my @ranges;
  for my $score (keys %$scores) {
   my $ranges = $scores->{$score};
   push @ranges, map { [ $score, rank($_), rank($ranges->{$_}) ]
                     } keys %$ranges;
  }
  @ranges = sort {$a->[1] cmp $b->[1]} @ranges;
  $ranges{$question} = \@ranges;
}

my %answers = (1 => 'K2', 2=>'F1');
my $total = 0;
while (my ($qu, $ans) = each %answers) {
 $ans = rank($ans);
 my ($aref) = grep { $_->[1] le $ans and $ans le $_->[2]
                   } @{$ranges{$qu}};
 $total += $aref->[0] if defined $aref;
}
print $total,"\n";
[download]