But then I can't use the round robin algorithm, and would have to create a new one to complete the schedule.

I'm thinking that having the teams diagonally opposite on the original round robin might be the best way because then they only overlap for one game as both home, minimising the number of games that will need changing - ie, for:

H   A
=====
A v B
C v D
E v F
G v H

teams 'B' and 'G' would be the ones from the same venue

Once again, trying to rewrite the question has provided a solution (I think). Here's my stab...

solution

A solution exists for all cases where at least 2 teams are not subject to the restriction.

Let's take the example where there are 8 teams (A-H)

Here's a sample schedule created using the round robin algorithm, home team listed first (for half the league, the second half is the same, but with home/away reversed)

A B   A C   A E   A G   A H   A F   A D
C D   E B   G C   H E   F G   D H   B F
E F   G D   H B   F C   D E   B G   C H
G H   H F   F D   D B   B C   C E   E G

Now let's assume that teams A and H don't have to worry about playing at home or away each week, but that the others do, and they are paired at the same venue as follows:

B & G
D & E
F & C 

When an instance occurs where two teams appear on the same side, simply swap the 'A' game around. So for the schedule above, it would become:

A B   B A   E A   G A   A H   A F   A D
C D   E B   G C   H E   F G   D H   B F
E F   G D   H B   F C   D E   B G   C H
G H   H F   F D   D B   B C   C E   E G

ie, swap the first game order around for half the 2nd to 4th games.

Assuming this extrapolates, I think I have my solution.

Now all I have to do is write an algorithm to rewrite the league schedule when some games have played and 2 or more teams decide to drop out...(sigh)

cLive ;-)

--
seek(JOB,$$LA,0);

Update: If we fall through to the bottom of the PROBLEM loop,
the code should die as it can't resolve the problem.
No change made to below.

#!/usr/bin/perl
use strict;
use warnings;

# XXX marks badness.

# This program assumes an elitist outlook.  The better team
# at a shared venue is always given preference to play at
# home vs. the 'B' team.
#
# Here team codes are generated:
#     1.1 is the #1 A team \
#     1.2 is the #1 B team -->  these share a venue: venue #1
#     2   is another team

# This is a quick hack, hacked straight through, i.e. inelegant
# run-on code.


my @match;   # periods w/ their pairings
my @entries; # the teams


############### Build the team list.
{
    my ( $entry_ct, $shared_tab_ct );
    ( $shared_tab_ct, $entry_ct) = ( 3, 18); # XXX magic values

    print "Total $entry_ct entries with ", 2* $shared_tab_ct,
      " sharing tables.\n";

    # Check specified constraint
    die "Too many shared tables" if 6* $shared_tab_ct < $entry_ct;

    # build entry list
    for ( my $e = 0 ; $e < $shared_tab_ct ; ++$e ) {
        push @entries, $e + 1 . ".1";
        push @entries, $e + 1 . ".2";
    }
    for ( my $e = $shared_tab_ct * 2 ; $e < $entry_ct ; ++$e ) {
        push @entries, $e + 1;
    }

    # maybe add a bye
    push @entries, "0" if @entries % 2;
}


# Create raw permutations for each periods' pairings.
my @sched;
{
    my @mute = @entries;
    my $head = shift @mute;
    my $period;
    for ( my $i = 1 ; $i <= @mute ; ++$i ) {
        $period = [ $head, @mute ];
        push @mute, $mute[0];
        shift @mute;
        push @sched, $period;
    }
}


# Do the pairings for each period.
for ( my $p = 0 ; $p < @sched ; ++$p ) {
    my @conflicts = ();

#    print "Period ", $p + 1, "\n";
    # Fold permutations to build naive pairings.
    for ( my $i = 0 ; $i < @entries / 2 ; ++$i ) {
        $match[$p]->[$i]->{home} = $sched[$p]->[$i];
        $match[$p]->[$i]->{away} = $sched[$p]->[ @entries - $i - 1 ];
    }

#    for ( my $j = 0 ; $j < @entries / 2 ; ++$j ) {
#        print "$match[$p]->[$j]->{home} vs $match[$p]->[$j]->{away}\n
+";
#    }


    # Find problem venues.
    for ( my $k = 0 ; $k < @entries / 2 ; ++$k ) {
        $conflicts[ int( $match[$p]->[$k]->{home} ) ] += 1;
    }
    my @prob_list = ();
    for ( my $i = 0 ; $i < @conflicts ; ++$i ) {
        push @prob_list, $i
            if ( defined $conflicts[$i] && 1 < $conflicts[$i] );
    }

#    { local $, = " "; print "\@prob_list", @prob_list, "\n"; }


    # Find non-problem shared venues -- can't let
    # these become problems.
    my @ok_list = ();
    for ( my $n = 0 ; $n < @entries / 2 ; ++$n ) {
        next unless is_sharing( $match[$p]->[$n]->{home} );
        next if
           grep $_ eq &venue( $match[$p]->[$n]->{home}), @prob_list;
        push @ok_list, venue( $match[$p]->[$n]->{home})
           unless
              grep $_ eq venue( $match[$p]->[$n]->{home}), @ok_list;
    }


#    unless (@prob_list) {
#        print "No Revision Necessary";
#        next;
#    }


    # Fix the problems.
    PROBLEM:
    foreach my $prob (@prob_list) {
        my $team = $prob . ".2";    # pick the B team
        my ($pair) =
          grep { $_->{home} eq $team } @{ @match->[$p] };
        if ($pair) {
            if ( not is_sharing( $pair->{away} ) ) {
                rev($pair);
                next PROBLEM;
            }
            else {
                if ( !grep $pair->{away} eq $_, @ok_list ) {
                    rev($pair);
                    push @ok_list, $pair->{away};
                    next PROBLEM;
                }
            }
        }
        else {
            $team = $prob . ".1";
            $pair = grep $_->{home} eq $team, @{@match->[$p]};
            if ($pair) {
                if ( not is_sharing( $pair->{away} ) ) {
                    rev($pair);
                    next PROBLEM;
                }
                else {
                  if (!grep $pair->{away} eq $_, @ok_list){           
+                                                                     
+                                                        
                        rev($pair);
                        push @ok_list, $pair->{away};
                        next PROBLEM;
                    }
                }
            }
        }
    }

    print "\nPeriod ", $p + 1, "\n";
    for ( my $j = 0 ; $j < @entries / 2 ; ++$j ) {
        print "$match[$p]->[$j]->{home} vs " .
             "$match[$p]->[$j]->{away}\n";
    }
    print "\n\n";
}


# Flip a pairing.
sub rev {
    ($_[0]->{home}, $_[0]->{away}) = ($_[0]->{away}, $_[0]->{home});
}


# Boolean:  Named team is_sharing a venue.
sub is_sharing { $_[0] != int( $_[0] ); }


# Get venue from team.
sub venue { int( $_[0] ); }
[download]