Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Case Exhaustion Tree

by Xiong (Hermit)
on Feb 02, 2014 at 20:33 UTC ( [id://1073085]=CUFP: print w/replies, xml ) Need Help??

For some time now I've been obsessed with clean decision trees. No solution is appropriate for all needs and, as usual, tradeoffs are in play. Today I hacked out one particular way of simplifying these trees.

Here's the original mess, which usually worked but sometimes did not, and looks messy: fragile, unmaintainable. A block of code is set up for string eval:

if ( not $code ) { $code = $unit; }; if ( $args and ref $args ) { @args = @$args; $code .= q{(@args)}; } else { @args = (); }; if ( $argv and ref $argv ) { @ARGV = @$argv; }

Both $code or $args may be supplied or not; and an attempt is made to exhaust all four possible cases. As you can see, I've painted myself into such a corner that I've introduced a third input variable.

Another approach, which truly annoys me, is to nest conditionals:

if ( $A ) { if ( $B ) { {...} } else { {...} }; } else { if ( $B ) { {...} } else { {...} }; };

This is so ugly and miserable I've rarely employed it. The second evaluation of the nested comparison, whatever it may be, is particularly offensive.

Alternatively, exhaust all four cases explicitly, at the cost of introducing two scratch flags:

# Four-outcome tree my $cf = !!$code; my $af = !!( $args and ref $args ); 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{()}; } else { die 'Fifth element!' };
  • Sets out all four cases explicitly.
  • All four cases at same level.
  • Flags guarantee simple boolean state.
  • Eliminates the wacky third input variable.

Of course tim toady; and I don't doubt others will rush to display their favorite decision trees. This one may work for me sometimes.

Death only closes a Man's Reputation, and determines it as good or bad. —Joseph Addison

Replies are listed 'Best First'.
Re: Case Exhaustion Tree
by tobyink (Canon) on Feb 03, 2014 at 09:56 UTC

    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{()}; }

    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{()}; }

    ... 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
      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
      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;
      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" }
      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.

    A reply falls below the community's threshold of quality. You may see it by logging in.
Re: Case Exhaustion Tree
by choroba (Cardinal) on Feb 02, 2014 at 21:01 UTC
    I would probably write it as
    $code ||= $unit; if (ref $args) { @args = @$args; $code .= q{(@args)}; } else { @args = (); } @ARGV = @$argv if ref $argv;

    YMMV.

    لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

      No; the approach is the general solution to exhausting unusual combinations of conditionals. A DB man might say I'd denormalized -- I dunno, I'm not a DB man.

      Death only closes a Man's Reputation, and determines it as good or bad. —Joseph Addison
Re: Case Exhaustion Tree
by Anonymous Monk on Feb 03, 2014 at 23:11 UTC

    This is an excellent approach to pick apart complicated logic and check that all bases are covered; essentially a Truth table in code.

    As you noted, the number of cases grows rapidly with the inputs, so logic minimization techniques (tables with Don't-care terms and Karnaugh maps) can be really helpful to simplify that, as can separating the outputs.

    I've often written out a truth table in comments above the (minimized) logic/code that implements it.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://1073085]
Approved by Old_Gray_Bear
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (4)
As of 2024-03-19 10:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found