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