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 (<FS>) {
    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(<DATA>) {
    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