sub allocate_minimal_rooms {
  my ($n_courses, $n_timeslots, $sched) = @_;
  my @ss = map join("", @$_), @$sched;
  my $best = [0 .. $n_courses-1];
  my $bestn = $n_courses;
  allocate(\@ss, [], 0, [], $best, \$bestn);
  return $best;
}

# Args:
# 1. array of schedule vectors
#     substr($s->[$n], $m, 1) is true if course $n meets during slot $m
#     scalar(@$s) is number of courses
# 2. array of room allocation vectors
#     substr($alloc->[$n], $m, 1) is true if room $n is full during slot $m
# 3. lowest-numbered unscheduled course
# 4. reference to solution currently being developed
# 5. reference to best solution so far
#    scalar(@$best) is # of rooms used
# 6. reference to number of rooms used in best solution so far
sub allocate {
  my ($s, $alloc, $i, $sol, $best, $bestn) = @_;
  if ($i == @$s) {
    # All courses allocated
    if ($$bestn > @$alloc) {    # New solution is better
      @$best = @$sol; $$bestn = @$alloc;
#      warn "New solution has @$best\n";
    }
    return;
  }
  return if @$alloc >= $$bestn;    # prune this branch

  my $c_sched = $s->[$i];
  for my $room_num (0 .. @$alloc) {

    # Class $i can't be scheduled in room $room_num because there is a conflict
    next if conflicts($c_sched, $alloc->[$room_num]);
    my $new_alloc = [@$alloc];
    $new_alloc->[$room_num] = union($new_alloc->[$room_num], $c_sched);
    allocate($s, $new_alloc, $i+1, [@$sol, $room_num], $best, $bestn);
  }
}

# Given two bit vector strings, form set union of bits
sub union {
  my ($a, $b) = @_;
  ! defined($a) ? $b : ! defined($b) ? $a : $a|$b;
}

# Given two bit vector strings, report whether the strings intersect
sub conflicts {
  my ($a, $b) = @_;
  return unless defined $a && defined $b;
  die "length mismatch" unless length($a) == length($b);
  return ($a&$b) =~ /1/;
}

__END__

Example test:
10010
01001
00101
00110

If you schedule this greedily, you get
10010 A
01001 A
00101 B
00110 C

but a better allocation is
10010 A
01001 B
00101 A
00110 B


