Ward Number In Perl

See WardNumber for the problem definition.

See WardNumberInManyProgrammingLanguages for many other implementations.

---

PerlLanguage

use strict;
my (%partners, %wardnumber, $p);
sub visit {
my ($cnt, @closer_folks) = @_;
my @newfolks;
foreach my $i (@closer_folks) {
foreach my $j (@{$partners{$i}}) {
unless ($wardnumber{$j}) {
$wardnumber{$j} = $cnt;
push @newfolks, $j;
}
}
}
visit (++$cnt, @newfolks) if @newfolks;
}
sub pair { push @{$partners{$_[0]}}, $_[1]; }
open FS, "data.txt";
while () {
if (/\s*(.*)\s*,\s*(.*)\s*/) {
pair($1,$2); pair ($2,$1);
}
}
visit(1, 'ward');
foreach $p (sort keys %wardnumber) { print "$p $wardnumber{$p}\n"}


---

Here's another one by JohnDouglasPorter

my %g; # the graph.
# parsing is not interesting.
for (
"al bob",
"bob cal",
"cal dave",
"dave ed ",
"cal fred",
"al ward",
"dave ward",
)
{
my( $x, $y ) = split;
$g{$x}{$y}++;
$g{$y}{$x}++;
}
sub graph_distance # BFS
{
my( $goal, $n ) = @_;
my @try_paths = ( [$n] );
while ( @try_paths )
{
my @path = @{ shift @try_paths };
$path[0] eq $goal and shift @path, return @path;
my %path_nodes; @path_nodes{ @path } = ();
my @next = grep { ! exists $path_nodes{$_} } keys %{ $g{$path[0]} };
@next and push @try_paths, map { [ $_, @path ] } @next;
}
die "No path from $n to $goal.\n";
}
my $n = 'ward';
my $wwnum = graph_distance( $n );
print "Ward number for $n is $wwnum\n";


---

And another by TonyBowden:

#!/usr/bin/perl -w
use strict;
use Class::Struct Programmer => { wardno => '$', pairs => '@' };
use List::Util 'min';
my @pairs = qw/al bob bob cal cal dave dave ed cal fred al ward dave ward/;
sub Programmer::add_pair {
my ($self, $prog) = @_;
$self->pairs([ @{$self->pairs}, $prog ]);
}
my %prog;
while (my ($x, $y) = map $prog{$_} ||= Programmer->new, splice @pairs, 0, 2) {
$x->add_pair($y);
$y->add_pair($x);
}
$prog{ward}->wardno(0);
while (my @need = grep !defined $_->wardno, values %prog) {
foreach my $prog (@need) {
my @known = grep defined, map $_->wardno, @{ $prog->pairs } or next;
$prog->wardno(1 + min @known);
}
}
sub ward_number { $prog{+shift}->wardno }


---

TMTOWTDI - here's one by AristotlePagaltzis:

This one calculates everyone's WardNumber with regard to the target programmer at once. The edge_distance() function here can actually be used on any graph where all edges are bidirectional.

#!/usr/bin/perl
use strict;
use warnings;
# idiomatic Perl
sub flatten_hashrefs {
return map { keys %{$_} } @_;
}
# very common idiom
sub list_contains {
my ($element, @list) = @_;
return scalar grep $_ eq $element, @list;
}
# hash of hashes that stores the graph
my %connections_of;
sub connected_to {
return flatten_hashrefs( @connections_of{@_} );
}
sub edge_distance {
my ($initial_node, $target_node) = @_;
my %seen;
my $wnum = 0;
my @occupied_node = ( $initial_node );
do {
# nodes we occupy have been seen
++$seen{$_} for @occupied_node;
# occupy connected nodes, except those we've seen before
@occupied_node = grep { !$seen{$_} } connected_to( @occupied_node );
# undefined edge distance if no route to target
return if not @occupied_node;
++$wnum;
}
until( list_contains( $target_node, @occupied_node ) );
return $wnum;
}
# read graph data
while() {
my ($from, $to) = split;
++$connections_of{$from}{$to};
++$connections_of{$to}{$from};
}
my $TARGET = shift( @ARGV ) || 'Ward';
for( keys %connections_of ) {
my $wnum = edge_distance( $_, $TARGET );
print defined( $wnum )
? "$wnum edges between $_ and $TARGET\n"
: "No route from $_ to $TARGET\n";
}
__END__
Al Ward
Joe John
Al Bob
Bob Cal
Cal Dave
Joe Peter
Ray Peter
Dave Ed
Cal Fred
Dave Ward


---

I think I would use Graph from CPAN: http://search.cpan.org/dist/Graph/

---

CategoryPerl