#!/usr/bin/perl -w use strict; use Graph; { package Graph; sub maximal_match { my($self, $vlist) = @_; my($path, %assign, %seen); while (($a = $self->alternating_path($vlist, \%assign, \%seen))) { $assign{$_->[0]} = $_->[1] for @$a; $seen{$_} = 1 for ($a->[0][0], $a->[$#$a][1]); } return wantarray ? %assign : scalar keys(%assign); } sub alternating_path { my($g, $vlist, $assign, $seen) = @_; my %rev = reverse %$assign; my %seen_locally; my $curlist = [ map [ $_ ], grep !$seen->{$_}, @$vlist ]; while (@$curlist) { my $nextlist = []; for my $cur (@$curlist) { my $v = pop @$cur; for my $next ($g->neighbours($v)) { next if $seen_locally{$next}++; return [ @$cur, [ $v, $next ] ] unless $seen->{$next}; push @$nextlist, [ @$cur, [ $v, $next ], $rev{$next} ]; } } $curlist = $nextlist; } return; } } # package Graph { package Hugo::Set; sub new { bless $_[1], $_[0] } sub graph { my $self = shift; $self->{graph} ||= do { my $g = Graph::Undirected->new; for my $var (@{ $self->{vars} }) { for my $value (@{ $self->{values} }) { $g->add_edge($var, $value); } } $g; }; } sub cleanup { my $self = shift; my $max = @{ $self->{vars} } - 1; my $g = $self->graph; for my $var (@{ $self->{vars} }) { for my $value ($g->neighbours($var)) { my $g2 = $g->copy_graph; $g2->delete_vertices($var, $value); next if $g2->maximal_match($self->{vars}) == $max; $g->delete_edge($var, $value); } } } } sub pretty { my $set = shift; my $g = $set->graph; for my $c ($g->connected_components) { my($vars, $values); push @{ /[a-z]/i ? $vars : $values }, $_ for sort @$c; printf " %s\n", join ' ', @$values; for my $var (@$vars) { printf "%s %s\n", $var, join ' ', map sprintf("%*d", length($_), $g->has_edge($var, $_) ? 1 : 0), @$values; } print "\n"; } } { my @varnames = ('A' .. 'Z'); my @values = (0 .. 99); my $test = 0; sub trial { printf "Test %s\n", ++$test; my @piece = split /\s+/, shift(); my $set = Hugo::Set->new({ vars => [ @varnames[0 .. $#piece] ], values => [ @values[1 .. length($piece[0])] ], }); my $var = 'A'; for (0 .. $#piece) { while ($piece[$_] =~ /0/g) { $set->graph->delete_edge($var, $+[0]); } ++$var; } pretty($set); $set->cleanup; pretty($set); } } trial($_) for grep length($_), split /\n/, <