in reply to Case Exhaustion Tree

Welcome back to the monastery Xiong. You must be exhausted after your long pilgrimage away from here. Sit down; take the weight off your feet; have a tankard of this year's brew.

Overall, I think your rewrite is an improvement of the original script. However, I think the else block which can never be reached may serve to confuse future readers of your scripture.

Also, I note that in the cases where $cf is false, you don't check that $unit is defined. Obviously I don't know the context where this code appears. Perhaps it is guaranteed to be defined. But if not, that's a case that should probably be covered. Doing the definedness check twice (within both blocks where $cf is false) violates DRY, so this could be done upfront.

# Four-outcome tree
my $cf      = !!$code;
my $af      = !!( $args and ref $args );

$cf or defined($unit) or die('$unit not defined');

if    (  $cf &&  $af ) {
    @ARGV       = @$args;
} 
elsif (  $cf && !$af ) {
    @args       = ();
} 
elsif ( !$cf &&  $af ) {
    @args       = @$args;
    $code       = $unit . q{(@args)};
} 
elsif ( !$cf && !$af ) {
    @args       = ();
    $code       = $unit . q{()};
}

[download]

Alternatively, you could use an assertion module (I keep meaning to release PerlX::Assert as a stand-alone module), which would allow:

# Four-outcome tree
my $cf      = !!$code;
my $af      = !!( $args and ref $args );
if    (  $cf &&  $af ) {
    @ARGV       = @$args;
} 
elsif (  $cf && !$af ) {
    @args       = ();
} 
elsif ( !$cf &&  $af ) {
    assert defined($unit);
    @args       = @$args;
    $code       = $unit . q{(@args)};
} 
elsif ( !$cf && !$af ) {
    assert defined($unit);
    @args       = ();
    $code       = $unit . q{()};
}

[download]

... which of course does include some repetition, but it's such a small amount of code that is repeated, it doesn't seem worth worrying about.

use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name

Replies are listed 'Best First'.
Re^2: Case Exhaustion Tree
by perl-diddler (Chaplain) on Mar 01, 2014 at 01:05 UTC
    Seems like you are doing it the hard way, but my way might be harder in a different way. I'd first write something to enumerate the different possibilities. (method varies, but like a "pick (3,5)" -- a random example I wrote in my perlish shell style): 
    #!/bin/bash -u

include stdalias

sub errmsg () {
  my code=1
  if (($#>1)) ; then
    code=$2
  fi
  echo "Error: $1"
  exit $code
}

# call with "parmnum <wanted>" - checks wanted against actual
alias parmnum='_parmnum $# '
sub _parmnum () {
  int expected=${1:-0-1} actual=$2
  if ((expected!=actual)) ; then 
    echo "Incorrect param count($actual). Expected $expected."
    exit 1
  fi
  return 0
}

sub permute () { # ( inArName  outArName)  #: randomly permute in->out
+)
  parmnum 2 
  my snam="$1" dnam="$2"
  readarray -t "$dnam"< <(printf "%s\n" $(
                        eval "echo \${$snam[@]}") | sort --random-sort
+)
}

sub pick () {   #(parms: #params  inArray_name  outArray_name)
  parmnum 3
  int savecnt=$1 cnt=$1
  my snam="$2" dnam="$3"
  set "" $(eval echo '${'$snam'[@]}' )
  shift
  if (($#<cnt)); then 
    printf "Cannot pick %s from list of len %s\n" "$cnt" "$#"
    exit 1
  fi
  eval "$dnam=()"
  while ((0 < cnt--));do
    eval "$dnam+=( \"$1\" )"
    shift || return 1
  done
  eval "$snam=( $(echo \"$@\") )"
  if (($(eval "echo \${#$dnam[@]}")<$savecnt)); then
    return 1
  fi
  return 0
}


sub dropcaches () {
  echo -n "3"|sudo dd of=/proc/sys/vm/drop_caches
}

# runall |& tee -a /tmp/ndd.log
if [[ $# -ge 2 ]]; then
  array in=( $(echo "$@") )
  array out
  array mypick
  permute in out
else 
  array in=( $(echo {1..8} ) )
  array out
  array mypick
  permute in out
fi

readarray -t ops< <(printf "%s\n" ''{,--nmmap} )

int dflt=8
int apt=2   #args/test
int args=$#
int nargs=$[args?args:dflt]
int nops=${#ops[@]}

if ((nops*apt>nargs)) ; then
  {
    printf "%s: Too few args for %s tests @ %s/test\n" \
            "$nargs" "$nops" "$apt"

    exit 1
  } >&2
fi


if [[ ! $0 =~ bash ]]; then 

  echo Drop Caches...
  dropcaches
  echo Start tests
  for op in "${ops[@]}"; do
    pick 2 out mypick
    cmd=$(echo "ndedup $op ${mypick[@]}" )
    echo "$cmd"
    time $cmd || exit $?
  done

fi

    [download]
    I didn't want the caches used in the same order each time to prevent disk locality from coming into play.... So basically permute & pick # vals from list.

    then for each test (this one tried 2 "ops" with and without "--nmmap")

    For more perlish work, I'd rewrite those in perl -- should be trivial.

    Then for execution, I would use either a hash or look through an array of cases, depending on howmuch control I needed over ordering. The thing is, the hash or array can be created on the fly, so you don't need to do the coding of the if/else cases... They can be run automatically after you put in the cases to test.

    Example of the ARRAY case to choose a format, with tests in order: 

          my $fmt;      # prototypes are documentary (rt#89053)
      my $given = [ sub ($$) { $_[0] =~ /^[-+]?[0-9]+\.?\z/     && q{%
+s}  },
                    sub ($$) { $_[1]                            && qq{
+%s}},
                    sub ($$) { 1 == length($_[0])               && q{'
+%s'}},
                    sub ($$) { $_[0] =~ m{^(?:[+-]?(?:\.[0-9]+)
                              | (?:[0-9]+\.[0-9]+))\z}x         &&  q{
+%.2f}},
                    sub ($$) { substr($_[0],0,5) eq 'HASH('     && 
                                                '{'.sw(ellipsis).'}'  
+},
                    sub ($$) { substr($_[0],0,6) eq 'ARRAY('    && 
                                                '['.sw(ellipsis).']'  
+},
                    # sub ($$) { $mxstr && length ($_[0])>$mxstr 
                    #           && qq("%.${mxstr}s")},
                    sub ($$) { 1                                && q{"
+%s"}} ];

      do { $fmt = $_->($v, $ro) and last } for @$given;
      return sprintf $fmt, $v;

    [download]
    And a hash case, (this time creating a format for refs): 
          no strict 'refs';
      my %actions = ( 
        GLOB  =>  ($p->{implicit_io}? *IO_glob: *NIO_glob),
        IO    =>  ($p->{implicit_io}? *IO_io   : *NIO_io),
        REF   =>  sub(){ "\\" . $p->Px($$_, $lvl-1) . ' '},
        SCALAR=>  sub(){ $pkg.'\\' . $p->Px($$_, $lvl).' ' },
        ARRAY =>  sub(){ $pkg."[". 
                        (join ', ', map{ $p->Px($_, $lvl) } @$v ) ."]"
+ },
        HASH  =>  sub(){ $pkg.'{' . ( join ', ', @{[
                    map {$p->Px($_, $lvl, 1) . '=>'. $p->Px($v->{$_}, 
+$lvl,0)} 
                    sort  nonrefs_b4_refs keys %$v]} ) . '}' },);
      if (my $act=$actions{$ref}) { &$act } 
      else { return "$v" }

    [download]
    You start using tables for decision trees, and it can simplify things.

    A third case... is using a sub or RE to match on, and calling the action based on that. With results from the first sub or RE being used as params in the action...

    I've been trying to eliminate all the features that are experimental from all my code since 5.18 . What a pointless exercise to have used them in the first place -- but I thought that they were only experimental for the 1st main release they were in, not "forever"...geez.

[reply]
[d/l]
[select]
A reply falls below the community's threshold of quality. You may see it by logging in.

In Section Cool Uses for Perl