[SPOILER] Verification Procedure and Test Case.

Shlomi Fish <shlomif-ik1l9ssToec+JF/[email protected]> Mon, 17 Jan 2005 21:48:38 +0200

Newsgroups	gmane.comp.lang.perl.qotw.discuss
Message-ID	<[email protected]>

The module TournVerify.pm that is attached to this message contains a function 
called verify_correctness, that given the number of teams, and the resultant 
schedule, verifies that it is a proper schedule. 

The test-script Test-Suite.t (also attached) makes use of this module and 
Test::More to test some representative numbers.

Finally, test-range.pl is a short script that tests the correctness of a range 
of numbers. So far I tested my solution (which will be included in a separate 
message), up to 882.

Regards,

	Shlomi Fish

---------------------------------------------------------------------
Shlomi Fish      shlomif-ik1l9ssToec+JF/[email protected]
Homepage:        http://www.shlomifish.org/

Knuth is not God! It took him two days to build the Roman Empire.

test-range.pl (application/x-perl, 319 B)

#!/usr/bin/perl -w

use strict;
use warnings;

use Tournament;
use TournVerify;

sub test_n
{
    my $n = shift;
    print STDERR "\$n=$n\n";
    my $verdict = verify_correctness($n, allocate_schedule($n));
    if ($verdict)
    {
        die "Failed for $n.";
    }
}

for my $i (1 .. 1000)
{
    test_n($i*2);
}

1;

Test-Suite.t (text/x-troff, 1.1 KB)

#!/usr/bin/perl -w

use strict;

use Test::More tests => 13;

use Tournament;

use TournVerify;

# Tests for verify_correctness
# TEST
ok (!verify_correctness(2, [[1, 0]]));

# TEST
ok (!verify_correctness(4, [[1,0,3,2],[2,3,0,1],[3,2,1,0]]));

# TEST
ok (!verify_correctness(2, allocate_schedule(2)));

# TEST
ok (!verify_correctness(4, allocate_schedule(4)));

# TEST
ok (!verify_correctness(6, allocate_schedule(6)));

# TEST
ok (!verify_correctness(16, allocate_schedule(16)));

# TEST
ok (!verify_correctness(10, allocate_schedule(10)));

# TEST
ok (!verify_correctness(14, allocate_schedule(14)));

# TEST
ok (!verify_correctness(22, allocate_schedule(22)));

# TEST
{
    my $n = 2*3*5;
    ok (!verify_correctness($n, allocate_schedule($n)));
}

# TEST
{
    my $n = 2*3*7;
    ok (!verify_correctness($n, allocate_schedule($n)));
}

# TEST
{
    my $n = 2*3*3;
    ok (!verify_correctness($n, allocate_schedule($n)));
}


{
    my $n = 2*3*5*7;
    # ok (!verify_correctness($n, allocate_schedule($n)));
}

# TEST
{
    my $n = 2*2*3;
    ok (!verify_correctness($n, allocate_schedule($n)));
}

TournVerify.pm (application/x-perl-module, 1.7 KB)

use strict;
use warnings;

sub verify_correctness
{
    my $n = shift;
    my $sched = shift;

    my $who_against_who = [ map { [ (0) x $n ] } (1 .. $n) ];

    my $day;
    for $day (0 .. ($n-2))
    {
        my $day_sched = $sched->[$day];
        for my $team (0 .. ($n-1))
        {
            my $other_team = $day_sched->[$team];
            if ($other_team == $team)
            {
                print STDERR "Day $day Team $team competes against itself.\n";
                return 1;
            }
            if (($other_team < 0) || ($other_team >= $n))
            {
                print STDERR "Day $day Team $team\'s opponent out of range.";
                return 1;
            }
            if ($day_sched->[$other_team] != $team)
            {
                print STDERR "Day $day Team $team opponent is not itself\n";
                return 1;
            }
            if (++$who_against_who->[$team]->[$other_team] > 2)
            {
                print STDERR 
                    "Teams $team, $other_team team played more than once\n";
                return 1;
            }
            if (++$who_against_who->[$other_team]->[$team] > 2)
            {
                print STDERR 
                    "Teams $team, $other_team team played more than once\n";
                return 1;
            }
        }
    }
    for my $team (0 .. ($n-1))
    {
        for my $other_team (0 .. ($n-1))
        {
            if ($who_against_who->[$team]->[$other_team] != 
                (($team == $other_team) ? 0 : 2))
            {
                print STDERR "w_a_w[$team][$other_team] is wrong.\n";
                return 1;
            }
        }
    }
    return 0;
}

1;