9
\$\begingroup\$

There's got to be a better way than this that preserves the logic while sparing me the multitude of lines:

sub has_path {
  clearerr;
  my %Graph = gref(shift);
  my $A = shift;
  my $B = shift;
  my $C = shift;
  my $D = shift;
  my $E = shift;
  my $F = shift;
  my $G = shift;
  my $H = shift;
  my $I = shift;
  my $J = shift;
  my $K = shift;
  my $L = shift;
  my $M = shift;
  my $N = shift;
  my $O = shift;
  my $P = shift;
  my $Q = shift;
  my $R = shift;
  my $S = shift;
  my $T = shift;
  my $U = shift;
  my $V = shift;
  my $W = shift;
  my $X = shift;
  my $Y = shift;
  my $Z = shift;
  # returns VT_BOOL
  my $bool = 0;
  my $switcher = dectab( [ $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R, $S, $T, $U, $V, $W, $X, $Y, $Z ] );
  given ($switcher) {
   when ( "--------------------------" ) {
    seterr( "No path." );
    } # no path
   when ( "X-------------------------" ) {
    seterr( "Path of one element." );
    } # path of 1 element
   when ( "XX------------------------" ) {
    $bool = $Graph->has_path( $A,  $B );
   }
   when ( "XXX-----------------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C );
   }
   when ( "XXXX----------------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D );
   }
   when ( "XXXXX---------------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E );
   }
   when ( "XXXXXX--------------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F );
   }
   when ( "XXXXXXX-------------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G );
   }
   when ( "XXXXXXXX------------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H );
   }
   when ( "XXXXXXXXX-----------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I );
   }
   when ( "XXXXXXXXXX----------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J );
   }
   when ( "XXXXXXXXXXX---------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K );
   }
   when ( "XXXXXXXXXXXX--------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L );
   }
   when ( "XXXXXXXXXXXXX-------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M );
   }
   when ( "XXXXXXXXXXXXXX------------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N );
   }
   when ( "XXXXXXXXXXXXXXX-----------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O );
   }
   when ( "XXXXXXXXXXXXXXXX----------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P );
   }
   when ( "XXXXXXXXXXXXXXXXX---------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q );
   }
   when ( "XXXXXXXXXXXXXXXXXX--------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R );
   }
   when ( "XXXXXXXXXXXXXXXXXXX-------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R, $S );
   }
   when ( "XXXXXXXXXXXXXXXXXXXX------" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R, $S, $T);
   }
   when ( "XXXXXXXXXXXXXXXXXXXXX-----" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R, $S, $T, $U );
   }
   when ( "XXXXXXXXXXXXXXXXXXXXXX----" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R, $S, $T, $U, $V );
   }
   when ( "XXXXXXXXXXXXXXXXXXXXXXX---" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R, $S, $T, $U, $V, $W );
   }
   when ( "XXXXXXXXXXXXXXXXXXXXXXXX--" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R, $S, $T, $U, $V, $W, $X );
   }
   when ( "XXXXXXXXXXXXXXXXXXXXXXXXX-" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R, $S, $T, $U, $V, $W, $X, $Y,);
   } 
   when ( "XXXXXXXXXXXXXXXXXXXXXXXXXX" ) {
    $bool = $Graph->has_path( $A,  $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N, $O, $P, $Q, $R, $S, $T, $U, $V, $W, $X, $Y, $Z );
   }
  }  
  return $bool;
 }

This is the dectab (decision table) sub it refers to:

 sub dectab {
  my($ref)=shift;
  my ($res);
  foreach my $key( @$ref){ 
   if ( ! defined $key ) { 
    $res .= '-';
   } else {
    $res .= "X";
   }
  }
  return $res;
 }

clearerr, seterr, and gref:

sub clearerr {
    $ERRORFLAGGED = 0;
    $ERRORTEXT = "";
}

sub seterr {
    $ERRORTEXT = shift;
    $ERRORFLAGGED = 1;
}

sub gref {
    my $gref = shift;
    if ( defined $grefs->{$gref} ) {
        return $grefs->{$gref};
    } else {
        return undef;
    }
}

This is all part of a much much larger wrapping of the Graph module. It's being turned into a COM DLL using ActiveState's PerlCtrl.

Calling the sub would be done, in VBScript (for example), by

set o = CreateObject("Wrapper.Graph.2")
...
if o.has_path( "tom", "dick", "harry" ) then 
...

Graph.pm, by the way, defines has_path as

has_path

   $g->has_path($a, $b, $c, ..., $x, $y, $z)

Return true if the graph has all the edges $a-$b, $b-$c, ..., $x-$y, $y-$z, false otherwise.
\$\endgroup\$
  • \$\begingroup\$ Arrays and slices, I think! \$\endgroup\$ – Jonathan Leffler Jan 31 '11 at 6:52
  • \$\begingroup\$ Can you give some sample data and a sample invocation of the function? Also, what is the gref function used on the first argument? It isn't in Perl 5.12.2 as a function listed at perldoc.perl.org AFAICS. Ditto the clearerr function (unless that's part of POSIX, or IO::Handle); what about the seterr function? \$\endgroup\$ – Jonathan Leffler Jan 31 '11 at 6:53
10
\$\begingroup\$

As I noted in a comment, I think the solution lies in using arrays and slices. Maybe like this:

sub has_path {
  clearerr;
  my %Graph = gref(shift);
  my(@States) = @_;
  my $bool = 0;
  my $switcher = dectab( [ @States ] );
  $switcher =~ m/^(X*)(?:-*)$/;
  my $number = length($1);
  if ($number == 0)  {
    seterr( "No path." );
  }
  else
  {
    $bool = $Graph->has_path( $States[0 .. ($length - 1)] );
  }

  return $bool;
} 

sub dectab {
  my($ref)=shift;
  my ($res);  foreach my $key( @$ref){ 
   if ( ! defined $key ) { 
    $res .= '-';
   } else {
    $res .= "X";
   }
  }
  return $res;
}

The key observations are:

  1. The list of letter variables is better treated as an array - I used @States.
  2. The output from dectab() (which is unaltered) consists of some number of X's followed by some number of dashes. The regex match identifies how many X's by isolating them into a string, $1, and then calculating the length of the string. Note that the code does not check that the output from dectab matches that pattern - it probably should.
  3. The huge switch statement amounts to supplying the elements 0..(N-1) to the $Graph->has_path() function, so the code passes the relevant slice of @States to the function.

There are still some bits I'm not clear about in your code. Specifically, I'm not sure about the roles (or sources) of the functions:

  • clearerr
  • gref
  • seterr

Because of that, I can't test my hypothesis. However, I do think that this solution scales to 200 items more easily than the original - and without needing:

use feature "switch";

With more time spent, the code could still be tidied up, I'm sure. And, since this is Perl, TMTOWTDI - there's more than one way to do it.


Suggestion:

  • Provide code that can be compiled and run whenever possible - you will get better code reviews that way.
\$\endgroup\$
  • \$\begingroup\$ Agreed, something compilable would be the go. In this case however, compilable means cooking up a much abbreviated PerlCtrl \$\endgroup\$ – bugmagnet Jan 31 '11 at 7:25
  • \$\begingroup\$ @boost: I think I'd want to be able to run the Pure Perl stuff before I started messing around with PerlCtrl. So, I'd make sure that I had a method of testing that would work. I don't use ActivePerl or Windows, so there's no way I can test properly. If this is the module Graph.pm to which you refer (and it looks like it is), it is helpful to let people know. It is helpful to include the preamble to the Perl code so people can see what modules you are using. And you could surely provide some data that shows how you create the Graph? \$\endgroup\$ – Jonathan Leffler Jan 31 '11 at 7:36
  • \$\begingroup\$ Pure Perl is part of the problem. If I write the demonstration in Pure Perl, the problem evaporates because one cannot help but enter code which will evaluate correctly. \$\endgroup\$ – bugmagnet Jan 31 '11 at 8:36
  • \$\begingroup\$ If I want to be able to pass up to 26 values, then I have to declare them and then figure out which ones are defined and which aren't. \$\endgroup\$ – bugmagnet Jan 31 '11 at 8:41
  • 1
    \$\begingroup\$ @boost: you treat them as an array - as I did with @State. You know how many elements are defined from scalar(@array) or variations such as $#array (a notation I almost never use). You can, just about, make your code work with 26; you can't sanely make your code work for 260. Give or take the processing time, there's no specific size limitation on the proposed rewrite. \$\endgroup\$ – Jonathan Leffler Jan 31 '11 at 14:48
8
\$\begingroup\$

Well:

The first line can be written like this:

sub has_path
{
  clearerr;
  my %Graph = gref(shift);

  my ($A, $B, $C, $D, $E, $F
     ,$G, $H, $I, $J, $K, $L
     ,$M, $N, $O, $P, $Q, $R
     ,$S, $T, $U, $V, $W, $X
     ,$Y, $Z)                    = @_;

But if all you are doing is using the parameters to call another function then just leave them in the array @_ and pass that to the function you are calling:

sub has_path
{
    clearerr;
    my %Graph = gref(shift);

    my $switcher = dectab( @_ );            # just use the input array (- graph)
                                            # as a parameter into dectab.
                                            # If you actually want to limit it then
                                            # splice() off then end.

    if ($switcher =~ /^(X+)(-*)$/)  # make sure the result is XXX----
    {
            my $size        = length($1);   # Count the X.
                                            # Note this block is not entered if
                                            # zero X's in switcher variable

            # Cut the $size elements from the input array
            # and pass them as parameters to has_path()
            return $Graph->has_path(splice(@_, 0 , $size));
    }
    # If we reach here the call failed.
    # Just return the 0
    return 0;
}
\$\endgroup\$
0
\$\begingroup\$

Unless I'm misunderstanding something, your has_path routine and all of its supporting routines can actually be collapsed to simply this:

sub has_path {
    my $graph = $grefs->{shift};
    return
        @_ == 0?  (0, "No path."):
        @_ == 1?  (0, "Path of one element."):
                  ($graph->has_path(@_), "");
}

which is callable like this:

my ($error_flagged, $error_text) = has_path($gref, $a, $b, $c, ...);

There is no need to do any of that dectab stuff, since has_path() takes a variable number of arguments already, and in the order you want.

(By the way, you wrote %Graph where I think you meant $Graph?)

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.